class
	APPLICATION

create
	make

feature {NONE} -- Initialization

	make
		local
			numbers: ARRAY [STRING]
		do
			numbers := <<"MCMXC", "MMVIII", "MDCLXVI",
			           -- 1990     2008      1666
			              "MMMCLIX", "MCMLXXVII", "MMX">>
			           -- 3159       1977         2010
			across numbers as n loop
				print (n.item +
                                       " in Roman numerals is " +
				       roman_to_decimal (n.item).out +
                                       " in decimal Arabic numerals.")
				print ("%N")
			end
		end

feature -- Roman numerals

	roman_to_decimal (a_str: STRING): INTEGER
		-- Decimal representation of Roman numeral `a_str'
		require
			is_roman (a_str)
		local
			l_pos: INTEGER
			cur: INTEGER -- Value of the digit read in the current iteration
			prev: INTEGER -- Value of the digit read in the previous iteration
		do
			from
				l_pos := 0
				Result := 0
				prev := 1 + max_digit_value
			until
				l_pos = a_str.count
			loop
				l_pos := l_pos + 1
				cur := roman_digit_to_decimal (a_str.at (l_pos))
				if cur <= prev then
					-- Add nonincreasing digit
					Result := Result + cur
				else
					-- Subtract previous digit from increasing digit
					Result := Result - prev + (cur - prev)
				end
				prev := cur
			end
		ensure
			Result >= 0
		end

	is_roman (a_string: STRING): BOOLEAN
		-- Is `a_string' a valid sequence of Roman digits?
		do
			Result := across a_string as c all is_roman_digit (c.item) end
		end

feature {NONE} -- Implementation

	max_digit_value: INTEGER = 1000

	is_roman_digit (a_char: CHARACTER): BOOLEAN
		-- Is `a_char' a valid Roman digit?
		local
			l_char: CHARACTER
		do
			l_char := a_char.as_upper
			inspect l_char
				when 'I', 'V', 'X', 'L', 'C', 'D', 'M' then
					Result := True
				else
					Result := False
			end
		end

	roman_digit_to_decimal (a_char: CHARACTER): INTEGER
		-- Decimal representation of Roman digit `a_char'
		require
			is_roman_digit (a_char)
		local
			l_char: CHARACTER
		do
			l_char := a_char.as_upper
			inspect l_char
				when 'I' then
					Result := 1
				when 'V' then
					Result := 5
				when 'X' then
					Result := 10
				when 'L' then
					Result := 50
				when 'C' then
					Result := 100
				when 'D' then
					Result := 500
				when 'M' then
					Result := 1000
			end
		ensure
			Result > 0
		end

end


import extensions;
import system'collections;
import system'routines;

static RomanDictionary = Dictionary.new()
                            .setAt("I".toChar(), 1)
                            .setAt("V".toChar(), 5)
                            .setAt("X".toChar(), 10)
                            .setAt("L".toChar(), 50)
                            .setAt("C".toChar(), 100)
                            .setAt("D".toChar(), 500)
                            .setAt("M".toChar(), 1000);

extension op : String
{
    toRomanInt()
    {
        var minus := 0;
        var s := self.upperCase();
        var total := 0;

        for(int i := 0, i < s.Length, i += 1)
        {
            var thisNumeral := RomanDictionary[s[i]] - minus;
            if (i >= s.Length - 1 || thisNumeral + minus >= RomanDictionary[s[i + 1]])
            {
                total += thisNumeral;
                minus := 0
            }
            else
            {
                minus := thisNumeral
            }
        };

        ^ total
    }
}

public program()
{
    console.printLine("MCMXC:  ", "MCMXC".toRomanInt());
    console.printLine("MMVIII: ", "MMVIII".toRomanInt());
    console.printLine("MDCLXVI:", "MDCLXVI".toRomanInt())
}


defmodule Roman_numeral do
  def decode([]), do: 0
  def decode([x]), do: to_value(x)
  def decode([h1, h2 | rest]) do
    case {to_value(h1), to_value(h2)} do
      {v1, v2} when v1 < v2 -> v2 - v1 + decode(rest)
      {v1, _} -> v1 + decode([h2 | rest])
    end
  end

  defp to_value(?M), do: 1000
  defp to_value(?D), do:  500
  defp to_value(?C), do:  100
  defp to_value(?L), do:   50
  defp to_value(?X), do:   10
  defp to_value(?V), do:    5
  defp to_value(?I), do:    1
end

Enum.each(['MCMXC', 'MMVIII', 'MDCLXVI', 'IIIID'], fn clist ->
  IO.puts "#{clist}\t: #{Roman_numeral.decode(clist)}"
end)


(defun ro2ar (RN)
  "Translate a roman number RN into arabic number.
   Its argument RN is wether a symbol, wether a list.
   Returns the arabic number. (ro2ar 'C) gives 100,
   (ro2ar '(X X I V)) gives 24"
  (cond
   ((eq RN 'M) 1000)
   ((eq RN 'D) 500)
   ((eq RN 'C) 100)
   ((eq RN 'L) 50)
   ((eq RN 'X) 10)
   ((eq RN 'V) 5)
   ((eq RN 'I) 1)
   ((null (cdr RN)) (ro2ar (car RN))) ;; stop recursion
   ((< (ro2ar (car RN)) (ro2ar (car (cdr RN)))) (- (ro2ar (cdr RN)) (ro2ar (car RN)))) ;; "IV" -> 5-1=4
   (t (+ (ro2ar (car RN)) (ro2ar (cdr RN)))))) ;; "VI" -> 5+1=6


-module( roman_numerals ).

-export( [decode_from_string/1]).

to_value($M) -> 1000;
to_value($D) ->  500;
to_value($C) ->  100;
to_value($L) ->   50;
to_value($X) ->   10;
to_value($V) ->    5;
to_value($I) ->    1.

decode_from_string([]) -> 0;
decode_from_string([H1]) -> to_value(H1);
decode_from_string([H1, H2 |Rest]) ->
    case {to_value(H1), to_value(H2)} of
        {V1, V2} when V1 < V2 -> V2 - V1 + decode_from_string(Rest);
        {V1, V1} -> V1 + V1 + decode_from_string(Rest);
        {V1, _} -> V1 + decode_from_string([H2|Rest])
    end.


PROGRAM ROMAN2ARAB

DIM R%[7]

PROCEDURE TOARAB(ROMAN$->ANS%)
      LOCAL I%,J%,P%,N%
      FOR I%=LEN(ROMAN$) TO 1 STEP -1 DO
        J%=INSTR("IVXLCDM",MID$(ROMAN$,I%,1))
        IF J%=0 THEN
            ANS%=-9999  ! illegal character
            EXIT PROCEDURE
        END IF
        IF J%>=P% THEN
            N%+=R%[J%]
          ELSE
            N%-=R%[J%]
        END IF
        P%=J%
      END FOR
      ANS%=N%
END PROCEDURE

BEGIN
  R%[]=(0,1,5,10,50,100,500,1000)
  TOARAB("MCMXCIX"->ANS%)         PRINT(ANS%)
  TOARAB("MMXII"->ANS%)           PRINT(ANS%)
  TOARAB("MDCLXVI"->ANS%)         PRINT(ANS%)
  TOARAB("MMMDCCCLXXXVIII"->ANS%) PRINT(ANS%)
END PROGRAM


constant symbols = "MDCLXVI", weights = {1000,500,100,50,10,5,1}
function romanDec(sequence roman)
    integer n, lastval, arabic
    lastval = 0
    arabic = 0
    for i = length(roman) to 1 by -1 do
        n = find(roman[i],symbols)
        if n then
            n = weights[n]
        end if
        if n < lastval then
            arabic -= n
        else
            arabic += n
        end if
        lastval = n
    end for
    return arabic
end function

? romanDec("MCMXCIX")
? romanDec("MDCLXVI")
? romanDec("XXV")
? romanDec("CMLIV")
? romanDec("MMXI")


let decimal_of_roman roman =
    let rec convert arabic lastval = function
        | head::tail ->
            let n = match head with
                    | 'M' | 'm' -> 1000
                    | 'D' | 'd' -> 500
                    | 'C' | 'c' -> 100
                    | 'L' | 'l' -> 50
                    | 'X' | 'x' -> 10
                    | 'V' | 'v' -> 5
                    | 'I' | 'i' -> 1
                    | _ -> 0
            let op = if n > lastval then (-) else (+)
            convert (op arabic lastval) n tail
        | _ -> arabic + lastval
    convert 0 0 (Seq.toList roman)
;;


USE: roman
( scratchpad ) "MMMCCCXXXIII" roman> .
3333


[ 32|   {get value of Roman digit on stack}
  $'m= $[\% 1000\]? ~[
  $'d= $[\% 500\]? ~[
  $'c= $[\% 100\]? ~[
  $'l= $[\% 50\]? ~[
  $'x= $[\% 10\]? ~[
  $'v= $[\% 5\]? ~[
  $'i= $[\% 1\]? ~[
  % 0
  ]?]?]?]?]?]?]?
]r:

0           {accumulator}
^r;!        {read first Roman digit}
[^r;!$][    {read another, and as long as it is valid...}
  \[email protected]@\[email protected]@  {copy previous and current}
  \>[\_\]?  {if previous smaller than current, negate previous}
  @@+\      {add previous to accumulator}
]#
%+.         {add final digit to accumulator and output}
10,         {and a newline}


create (arabic)
  1000 128 * char M + ,
   500 128 * char D + ,
   100 128 * char C + ,
    50 128 * char L + ,
    10 128 * char X + ,
     5 128 * char V + ,
     1 128 * char I + ,
does>
  7 cells bounds do
    i @ over over 127 and = if nip 7 rshift leave else drop then
  1 cells +loop dup
;

: >arabic
  0 dup >r >r
  begin
    over over
  while
    [email protected] dup (arabic) rot <>
  while
    r> over r> over over > if 2* negate + else drop then + swap >r >r 1 /string
  repeat then drop 2drop r> r> drop
;

s" MCMLXXXIV" >arabic .


program Roman_decode
  implicit none

  write(*,*) decode("MCMXC"), decode("MMVIII"), decode("MDCLXVI")

contains

function decode(roman) result(arabic)
  character(*), intent(in) :: roman
  integer :: i, n, lastval, arabic

  arabic = 0
  lastval = 0
  do i = len(roman), 1, -1
    select case(roman(i:i))
      case ('M','m')
        n = 1000
      case ('D','d')
        n = 500
      case ('C','c')
        n = 100
      case ('L','l')
        n = 50
      case ('X','x')
        n = 10
      case ('V','v')
        n = 5
      case ('I','i')
        n = 1
      case default
        n = 0
    end select
    if (n < lastval) then
      arabic = arabic - n
    else
      arabic = arabic + n
    end if
    lastval = n
  end do
end function decode
end program Roman_decode


' FB 1.05.0 Win64

Function romanDecode(roman As Const String) As Integer
  If roman = "" Then Return 0  '' zero denotes invalid roman number
  Dim roman1(0 To 2) As String = {"MMM", "MM", "M"}
  Dim roman2(0 To 8) As String = {"CM", "DCCC", "DCC", "DC", "D", "CD", "CCC", "CC", "C"}
  Dim roman3(0 To 8) As String = {"XC", "LXXX", "LXX", "LX", "L", "XL", "XXX", "XX", "X"}
  Dim roman4(0 To 8) As String = {"IX", "VIII", "VII", "VI", "V", "IV", "III", "II", "I"}
  Dim As Integer i, value = 0, length = 0
  Dim r As String = UCase(roman)

  For i = 0 To 2
    If Left(r, Len(roman1(i))) = roman1(i) Then
      value += 1000 * (3 - i)
      length = Len(roman1(i))
      r = Mid(r, length + 1)
      length = 0
      Exit For
    End If
  Next

  For i = 0 To 8
    If Left(r, Len(roman2(i))) = roman2(i) Then
      value += 100 * (9 - i)
      length = Len(roman2(i))
      r = Mid(r, length + 1)
      length = 0
      Exit For
    End If
  Next

  For i = 0 To 8
    If Left(r, Len(roman3(i))) = roman3(i) Then
      value += 10 * (9 - i)
      length = Len(roman3(i))
      r = Mid(r, length + 1)
      length = 0
      Exit For
    End If
  Next

  For i = 0 To 8
    If Left(r, Len(roman4(i))) = roman4(i) Then
      value += 9 - i
      length = Len(roman4(i))
      Exit For
    End If
  Next

  ' Can't be a valid roman number if there are any characters left
  If Len(r) > length Then Return 0
  Return value
End Function

Dim a(2) As String = {"MCMXC", "MMVIII" , "MDCLXVI"}
For i As Integer = 0 To 2
  Print a(i); Tab(8); " =>"; romanDecode(a(i))
Next

Print
Print "Press any key to quit"
Sleep


window 1

local fn RomantoDecimal( roman as CFStringRef ) as long
  long i, n, preNum = 0, num = 0

  for i = len(roman) - 1 to 0 step -1
    n = 0
    select ( fn StringCharacterAtIndex( roman, i ) )
      case _"M" : n = 1000
      case _"D" : n = 500
      case _"C" : n = 100
      case _"L" : n = 50
      case _"X" : n = 10
      case _"V" : n = 5
      case _"I" : n = 1
    end select
    if ( n < preNum ) then num = num - n else num = num + n
    preNum = n
  next

end fn = num

print @"  MCMXC = "; fn RomantoDecimal( @"MCMXC"   )
print @" MMVIII = "; fn RomantoDecimal( @"MMVIII"  )
print @"  MMXVI = "; fn RomantoDecimal( @"MMXVI"   )
print @"MDCLXVI = "; fn RomantoDecimal( @"MDCLXVI" )
print @" MCMXIV = "; fn RomantoDecimal( @"MCMXIV"  )
print @"  DXIII = "; fn RomantoDecimal( @"DXIII"   )
print @"      M = "; fn RomantoDecimal( @"M"       )
print @"  DXIII = "; fn RomantoDecimal( @"DXIII"   )
print @" XXXIII = "; fn RomantoDecimal( @"XXXIII"  )

HandleEvents


'This code will create a GUI Form and Objects and carry out the Roman Numeral convertion as you type
'The input is case insensitive
'A basic check for invalid charaters is made

hTextBox As TextBox                                           'To allow the creation of a TextBox
hValueBox As ValueBox                                         'To allow the creation of a ValueBox

Public Sub Form_Open()                                        'Form opens..

SetUpForm                                                     'Go to the SetUpForm Routine
hTextBox.text = "MCMXC"                                       'Put a Roman numeral in the TextBox

End

Public Sub TextBoxInput_Change()                              'Each time the TextBox text changes..
Dim cRomanN As Collection = ["M": 1000, "D": 500, "C": 100, "L": 50, "X": 10, "V": 5, "I": 1]  'Collection of nemerals e.g 'M' = 1000
Dim cMinus As Collection = ["IV": -2, "IX": -2, "XL": -20, "XC": - 20, "CD": -200, "CM": -200] 'Collection of the 'one less than' numbers e.g. 'IV' = 4
Dim sClean, sTemp As String                                   'Various string variables
Dim siCount As Short                                          'Counter
Dim iTotal As Integer                                         'Stores the total of the calculation

hTextBox.Text = UCase(hTextBox.Text)                          'Make any text in the TextBox upper case

For siCount = 1 To Len(hTextBox.Text)                         'Loop through each character in the TextBox
  If InStr("MDCLXVI", Mid(hTextBox.Text, siCount, 1)) Then    'If a Roman numeral exists then..
    sClean &= Mid(hTextBox.Text, siCount, 1)                  'Put it in 'sClean' (Stops input of non Roman numerals)
  End If
Next

hTextBox.Text = sClean                                        'Put the now clean text in the TextBox

For siCount = 1 To Len(hTextBox.Text)                         'Loop through each character in the TextBox
  iTotal += cRomanN[Mid(hTextBox.Text, siCount, 1)]           'Total up all the characters, note 'IX' will = 11 not 9
Next

For Each sTemp In cMinus                                      'Loop through each item in the cMinus Collection
  If InStr(sClean, cMinus.Key) > 0 Then iTotal += Val(sTemp)  'If a 'Minus' value is in the string e.g. 'IX' which has been calculated at 11 subtract 2 = 9
Next

hValueBox.text = iTotal                                       'Display the total

End

Public Sub SetUpForm()                                        'Create the Objects for the Form
Dim hLabel1, hLabel2 As Label                                 'For 2 Labels

Me.height = 150                                               'Form Height
Me.Width = 300                                                'Form Width
Me.Padding = 20                                               'Form padding (border)
Me.Text = "Roman Numeral converter"                           'Text in Form header
Me.Arrangement = Arrange.Vertical                             'Form arrangement

hLabel1 = New Label(Me)                                       'Create a Label
hLabel1.Height = 21                                           'Label Height
hLabel1.expand = True                                         'Expand the Label
hLabel1.Text = "Enter a Roman numeral"                        'Put text in the Label

hTextBox = New TextBox(Me) As "TextBoxInput"                  'Set up a TextBox with an Event Label
hTextBox.Height = 21                                          'TextBox height
hTextBox.expand = True                                        'Expand the TextBox

hLabel2 = New Label(Me)                                       'Create a Label
hLabel2.Height = 21                                           'Label Height
hLabel2.expand = True                                         'Expand the Label
hLabel2.Text = "The decimal equivelent is: -"                 'Put text in the Label

hValueBox = New ValueBox(Me)                                  'Create a ValueBox
hValueBox.Height = 21                                         'ValuBox Height
hValueBox.expand = True                                       'Expand the ValueBox
hValueBox.ReadOnly = True                                     'Set ValueBox to Read Only

End


package main

import (
    "errors"
    "fmt"
)

var m = map[rune]int{
    'I': 1,
    'V': 5,
    'X': 10,
    'L': 50,
    'C': 100,
    'D': 500,
    'M': 1000,
}

func parseRoman(s string) (r int, err error) {
    if s == "" {
        return 0, errors.New("Empty string")
    }
    is := []rune(s) // easier to convert string up front
    var c0 rune     // c0: roman character last read
    var cv0 int     // cv0: value of cv

    // the key to the algorithm is to process digits from right to left
    for i := len(is) - 1; i >= 0; i-- {
        // read roman digit
        c := is[i]
        k := c == '\u0305' // unicode overbar combining character
        if k {
            if i == 0 {
                return 0, errors.New(
                    "Overbar combining character invalid at position 0")
            }
            i--
            c = is[i]
        }
        cv := m[c]
        if cv == 0 {
            if c == 0x0305 {
                return 0, fmt.Errorf(
                    "Overbar combining character invalid at position %d", i)
            } else {
                return 0, fmt.Errorf(
                    "Character unrecognized as Roman digit: %c", c)
            }
        }
        if k {
            c = -c // convention indicating overbar
            cv *= 1000
        }

        // handle cases of new, same, subtractive, changed, in that order.
        switch {
        default: // case 4: digit change
            fallthrough
        case c0 == 0: // case 1: no previous digit
            c0 = c
            cv0 = cv
        case c == c0: // case 2: same digit
        case cv*5 == cv0 || cv*10 == cv0: // case 3: subtractive
            // handle next digit as new.
            // a subtractive digit doesn't count as a previous digit.
            c0 = 0
            r -= cv  // subtract...
            continue // ...instead of adding
        }
        r += cv // add, in all cases except subtractive
    }
    return r, nil
}

func main() {
    // parse three numbers mentioned in task description
    for _, r := range []string{"MCMXC", "MMVIII", "MDCLXVI"} {
        v, err := parseRoman(r)
        if err != nil {
            fmt.Println(err)
        } else {
            fmt.Println(r, "==", v)
        }
    }
}


#!/usr/bin/env golosh
----
This module converts a Roman numeral into a decimal number.
----
module Romannumeralsdecode

augment java.lang.Character {

  function decode = |this| -> match {
    when this == 'I' then 1
    when this == 'V' then 5
    when this == 'X' then 10
    when this == 'L' then 50
    when this == 'C' then 100
    when this == 'D' then 500
    when this == 'M' then 1000
    otherwise 0
  }
}

augment java.lang.String {

  function decode = |this| {
    var accumulator = 0
    foreach i in [0..this: length()] {
      let currentChar = this: charAt(i)
      let nextChar = match {
        when i + 1 < this: length() then this: charAt(i + 1)
        otherwise null
      }
      if (currentChar: decode() < (nextChar?: decode() orIfNull 0)) {
        # if this is something like IV or IX or whatever
        accumulator = accumulator - currentChar: decode()
      } else {
        accumulator = accumulator + currentChar: decode()
      }
    }
    return accumulator
  }
}

function main = |args| {
  println("MCMXC = " + "MCMXC": decode())
  println("MMVIII = " + "MMVIII": decode())
  println("MDCLXVI = " + "MDCLXVI": decode())
}


enum RomanDigits {
    I(1), V(5), X(10), L(50), C(100), D(500), M(1000);

    private magnitude;
    private RomanDigits(magnitude) { this.magnitude = magnitude }

    String toString() { super.toString() + "=${magnitude}" }

    static BigInteger parse(String numeral) {
        assert numeral != null && !numeral.empty
        def digits = (numeral as List).collect {
            RomanDigits.valueOf(it)
        }
        def L = digits.size()
        (0..<L).inject(0g) { total, i ->
            def sign = (i == L - 1 || digits[i] >= digits[i+1]) ? 1 : -1
            total + sign * digits[i].magnitude
        }
    }
}


module Main where

------------------------
--  DECODER FUNCTION  --
------------------------

decodeDigit :: Char -> Int
decodeDigit 'I' = 1
decodeDigit 'V' = 5
decodeDigit 'X' = 10
decodeDigit 'L' = 50
decodeDigit 'C' = 100
decodeDigit 'D' = 500
decodeDigit 'M' = 1000
decodeDigit _ = error "invalid digit"

--  We process a Roman numeral from right to left, digit by digit, adding the value.
--  If a digit is lower than the previous then its value is negative.
--  The first digit is always positive.

decode roman = decodeRoman startValue startValue rest
  where
    (first:rest) = reverse roman
    startValue = decodeDigit first

decodeRoman :: Int -> Int -> [Char] -> Int
decodeRoman lastSum _ [] = lastSum
decodeRoman lastSum lastValue (digit:rest) = decodeRoman updatedSum digitValue rest
  where
    digitValue = decodeDigit digit
    updatedSum = (if digitValue < lastValue then (-) else (+)) lastSum digitValue

------------------
--  TEST SUITE  --
------------------

main = do
  test "MCMXC" 1990
  test "MMVIII" 2008
  test "MDCLXVI" 1666

test roman expected = putStrLn (roman ++ " = " ++ (show (arabic)) ++ remark)
  where
    arabic = decode roman
    remark = " (" ++ (if arabic == expected then "PASS" else ("FAIL, expected " ++ (show expected))) ++ ")"


link numbers

procedure main()
every R := "MCMXC"|"MDCLXVI"|"MMVIII" do
   write(R, " = ",unroman(R))
end


public class Roman {
	private static int decodeSingle(char letter) {
		switch(letter) {
			case 'M': return 1000;
			case 'D': return 500;
			case 'C': return 100;
			case 'L': return 50;
			case 'X': return 10;
			case 'V': return 5;
			case 'I': return 1;
			default: return 0;
		}
	}
	public static int decode(String roman) {
		int result = 0;
		String uRoman = roman.toUpperCase(); //case-insensitive
		for(int i = 0;i < uRoman.length() - 1;i++) {//loop over all but the last character
			//if this character has a lower value than the next character
			if (decodeSingle(uRoman.charAt(i)) < decodeSingle(uRoman.charAt(i+1))) {
				//subtract it
				result -= decodeSingle(uRoman.charAt(i));
			} else {
				//add it
				result += decodeSingle(uRoman.charAt(i));
			}
		}
		//decode the last character, which is always added
		result += decodeSingle(uRoman.charAt(uRoman.length()-1));
		return result;
	}

	public static void main(String[] args) {
		System.out.println(decode("MCMXC")); //1990
		System.out.println(decode("MMVIII")); //2008
		System.out.println(decode("MDCLXVI")); //1666
	}
}


var Roman = {
  Values: [['CM', 900],  ['CD', 400], ['XC',  90], ['XL',  40], ['IV', 4],
           ['IX',   9], ['V',   5], ['X',   10], ['L',  50],
           ['C',  100], ['M', 1000], ['I',    1], ['D',  500]],
  UnmappedStr : 'Q',
  parse: function(str) {
    var result = 0
    for (var i=0; i<Roman.Values.length; ++i) {
      var pair = Roman.Values[i]
      var key = pair[0]
      var value = pair[1]
      var regex = RegExp(key)
      while (str.match(regex)) {
        result += value
        str = str.replace(regex, Roman.UnmappedStr)
      }
    }
    return result
  }
}

var test_data = ['MCMXC', 'MDCLXVI', 'MMVIII']
for (var i=0; i<test_data.length; ++i) {
  var test_datum = test_data[i]
  print(test_datum + ": " + Roman.parse(test_datum))
}


def fromRoman:
  def addRoman(n):
    if length == 0 then n
    elif startswith("M")  then .[1:] | addRoman(1000 + n)
    elif startswith("CM") then .[2:] | addRoman(900 + n)
    elif startswith("D")  then .[1:] | addRoman(500 + n)
    elif startswith("CD") then .[2:] | addRoman(400 + n)
    elif startswith("C")  then .[1:] | addRoman(100 + n)
    elif startswith("XC") then .[2:] | addRoman(90 + n)
    elif startswith("L")  then .[1:] | addRoman(50 + n)
    elif startswith("XL") then .[2:] | addRoman(40 + n)
    elif startswith("X")  then .[1:] | addRoman(10 + n)
    elif startswith("IX") then .[2:] | addRoman(9 + n)
    elif startswith("V")  then .[1:] | addRoman(5 + n)
    elif startswith("IV") then .[2:] | addRoman(4 + n)
    elif startswith("I")  then .[1:] | addRoman(1 + n)
    else
      error("invalid Roman numeral: " + tostring)
    end;
  addRoman(0);


prompt$ jsish -e 'require("Roman"); puts(Roman.fromRoman("MDCLXVI"));'
1666


function parseroman(rnum::AbstractString)
    romandigits = Dict('I' => 1, 'V' => 5, 'X' => 10, 'L' => 50,
                       'C' => 100, 'D' => 500, 'M' => 1000)
    mval = accm = 0
    for d in reverse(uppercase(rnum))
        val = try
            romandigits[d]
        catch
            throw(DomainError())
        end
        if val > mval maxval = val end
        if val < mval
            accm -= val
        else
            accm += val
        end
    end
    return accm
end


// version 1.0.6

fun romanDecode(roman: String): Int {
    if (roman.isEmpty()) return 0
    var n = 0
    var last = 'O'
    for (c in roman) {
        when (c) {
            'I' -> n += 1
            'V' -> if (last == 'I') n += 3   else n += 5
            'X' -> if (last == 'I') n += 8   else n += 10
            'L' -> if (last == 'X') n += 30  else n += 50
            'C' -> if (last == 'X') n += 80  else n += 100
            'D' -> if (last == 'C') n += 300 else n += 500
            'M' -> if (last == 'C') n += 800 else n += 1000
        }
        last = c
    }
    return n
}

fun main(args: Array<String>) {
    val romans = arrayOf("I", "III", "IV", "VIII", "XLIX", "CCII", "CDXXXIII", "MCMXC", "MMVIII", "MDCLXVI")
    for (roman in romans) println("${roman.padEnd(10)} = ${romanDecode(roman)}")
}


define br => '\r'
//decode roman
define decodeRoman(roman::string)::integer => {
	local(ref = array('M'=1000, 'CM'=900, 'D'=500, 'CD'=400, 'C'=100, 'XC'=90, 'L'=50, 'XL'=40, 'X'=10, 'IX'=9, 'V'=5, 'IV'=4, 'I'=1))
	local(out = integer)
	while(#roman->size) => {
		// need to use neset while instead of query expr to utilize loop_abort
		while(loop_count <= #ref->size) => {
			if(#roman->beginswith(#ref->get(loop_count)->first)) => {
				#out += #ref->get(loop_count)->second
				#roman->remove(1,#ref->get(loop_count)->first->size)
				loop_abort
			}
		}
	}
	return #out
}

'MCMXC as integer is '+decodeRoman('MCMXC')
br
'MMVIII as integer is '+decodeRoman('MMVIII')
br
'MDCLXVI as integer is '+decodeRoman('MDCLXVI')


  print "MCMXCIX = "; romanDec( "MCMXCIX") '1999
  print "MDCLXVI = "; romanDec( "MDCLXVI") '1666
  print "XXV     = "; romanDec( "XXV")     '25
  print "CMLIV   = "; romanDec( "CMLIV")   '954
  print "MMXI    = "; romanDec( "MMXI")    '2011

  end

function romanDec( roman$)
  arabic  =0
  lastval =0

  for i = len( roman$) to 1 step -1
    select case upper$( mid$( roman$, i, 1))
      case "M"
        n = 1000
      case "D"
        n = 500
      case "C"
        n = 100
      case "L"
        n = 50
      case "X"
        n = 10
      case "V"
        n = 5
      case "I"
        n = 1
      case else
        n = 0
    end select

    if n <lastval then
      arabic =arabic -n
    else
      arabic =arabic +n
    end if

    lastval =n
  next

  romanDec =arabic
end function


require! 'prelude-ls': {fold, sum}

# String → Number
decimal_of_roman = do
  # [Number, Number] → String → [Number, Number]
  _convert = ([acc, last_value], ch) ->
    current_value = { M:1000 D:500 C:100 L:50 X:10 V:5 I:1 }[ch] ? 0
    op = if last_value < current_value then (-) else (+)
    [op(acc, last_value), current_value]
  # fold the string and sum the resulting tuple (array)
  fold(_convert, [0, 0]) >> sum

{[rom, decimal_of_roman rom] for rom in <[ MCMXC MMVII MDCLXVII MMMCLIX MCMLXXVII MMX ]>}


; Roman numeral decoder

; First, some useful substring utilities
to starts_with? :string :prefix
  if empty? :prefix [output "true]
  if empty? :string [output "false]
  if not equal? first :string first :prefix [output "false]
  output starts_with? butfirst :string butfirst :prefix
end

to remove_prefix :string :prefix
  if or empty? :prefix not starts_with? :string :prefix [output :string]
  output remove_prefix butfirst :string butfirst :prefix
end

; Our list of Roman numeral values
make "values [[M 1000] [CM 900] [D  500] [CD 400] [C  100] [XC 90] [L 50]
              [XL 40]  [X  10]  [IX 9]   [V  5]   [IV 4]   [I  1]]

; Function to do the work
to from_roman :str
 local "n make "n 0
 foreach :values [
   local "s make "s first ?
   local "v make "v last ?
   while [starts_with? :str :s] [
     make "n sum n :v
     make "str remove_prefix :str :s
   ]
 ]
 output :n
end

foreach [MCMXC MDCLXVI MMVIII] [print (sentence (word ? "|: |) from_roman ?)]
bye


function ToNumeral( roman )
    local Num = { ["M"] = 1000, ["D"] = 500, ["C"] = 100, ["L"] = 50, ["X"] = 10, ["V"] = 5, ["I"] = 1 }
    local numeral = 0

    local i = 1
    local strlen = string.len(roman)
    while i < strlen do
        local z1, z2 = Num[ string.sub(roman,i,i) ], Num[ string.sub(roman,i+1,i+1) ]
        if z1 < z2 then
            numeral = numeral + ( z2 - z1 )
            i = i + 2
        else
            numeral = numeral + z1
            i = i + 1
        end
    end

    if i <= strlen then numeral = numeral + Num[ string.sub(roman,i,i) ] end

    return numeral
end

print( ToNumeral( "MCMXC" ) )
print( ToNumeral( "MMVIII" ) )
print( ToNumeral( "MDCLXVI" ) )


Module RomanNumbers {
      flush  ' empty current stack
      gosub Initialize
      document Doc$
      while not empty
            read rom$
            print rom$;"=";RomanEval$(rom$)
            Doc$=rom$+"="+RomanEval$(rom$)+{
            }
      end while
      Clipboard Doc$
      end
Initialize:
      function RomanEval$(rom$) {
            Flush
            ="invalid"
            if filter$(rom$,"MDCLXVI")<>"" Then Exit
            \\ "Y" is in top of stack
            Push "CM", "MD", "Q"
            Push "CD", "MD","W"
            Push "XC", "DL", "E"
            Push "XL", "X","R"
            Push "IX","V","T"
            Push  "IV","I","Y"
            \\ stack flush to doublerom
            doublerom=[]
            \\  "M" is in top of stack
            Data "M", 1000, "Q",900
            Data "D", 500,"W", 400
            Data "C",100,"E",90
            Data "L",50,"R", 40
            Data "X", 10, "T", 9
            Data "V", 5, "Y", 4, "I",1
            \\ stack flush to singlerom
            singlerom=[]
            acc=0
            value=0
            count=0
            stack doublerom {
                  if empty then exit
                  read rep$,exclude$,cc$
                  i=instr(rom$,cc$)
                  if i >0 then
                        tmp$=mid$(rom$,i+2)
                        L=Len(tmp$)
                        if L>0 then if Len(filter$(tmp$, exclude$))<>L then rom$="A": exit
                        if Instr(rom$,mid$(rom$,i,1))<i then rom$="A": exit
                        insert i,2 rom$=rep$  ' replace at pos i with rep$ and place a space to i+1
                  end if
                  loop
            }
            rom$=filter$(rom$," ") ' remove spaces if exist

            stack singlerom {
                  if empty then exit
                  read cc$, value
                  count=0
                  while left$(rom$,1)=cc$
                         insert 1, 1 rom$=""
                         count++
                         acc+=value
                  end while
                  if count>3 then exit
                  loop
            }
            if len(rom$)>0  or count>3 Else
                  =Str$(acc,1033)
            end if
      }
      data "MMMCMXCIX", "LXXIIX", "MMXVII", "LXXIX", "CXCIX","MCMXCIX","MMMDCCCLXXXVIII"
      data "CMXI","M","MCDXLIV","CCCC","IXV", "XLIXL","LXXIIX","IVM"
      data "XXXIX", "XXXX", "XIXX","IVI", "XLIX","XCIX","XCIV","XLVIII"
      return
}
RomanNumbers


f := n -> convert(n, arabic):
seq(printf("%a\n", f(i)), i in [MCMXC, MMVIII, MDCLXVI]);


function x = rom2dec(s)
% ROM2DEC converts Roman numbers to decimal

% store Roman digits values: I=1, V=5, X=10, L=50, C=100, D=500, M=1000
digitsValues = [0 0 100 500 0 0 0 0 1 0 0 50 1000 0 0 0 0 0 0 0 0 5 0 10 0 0];
% convert Roman number to array of values
values = digitsValues(s-'A'+1);
% change sign if next value is bigger
x = sum(values .* [sign(diff(-values)+eps),1]);

end


:- module test_roman.

:- interface.

:- import_module io.

:- pred main(io::di, io::uo) is det.

:- implementation.

:- import_module char.
:- import_module exception.
:- import_module int.
:- import_module list.
:- import_module string.

:- type conversion_error --->  not_a_roman_number.

:- func build_int(list(char), int, int) = int.
:- func from_roman(string) = int.
:- pred roman_to_int(char::in, int::out) is semidet.

from_roman(Roman) = Decimal :-
  List = reverse(to_char_list(Roman)),
  Decimal = build_int(List, 0, 0).

build_int([], LastValue, Accumulator) = LastValue + Accumulator.
build_int([Digit|Rest], LastValue, Accumulator) = Sum :-
  ( roman_to_int(Digit, Value) ->
      ( Value < LastValue ->
          Sum = build_int(Rest, Value, Accumulator - LastValue)
      ;   Sum = build_int(Rest, Value, Accumulator + LastValue) )
  ;   throw(not_a_roman_number) ).

roman_to_int('I', 1).
roman_to_int('V', 5).
roman_to_int('X', 10).
roman_to_int('L', 50).
roman_to_int('C', 100).
roman_to_int('D', 500).
roman_to_int('M', 1000).

main(!IO) :-
    command_line_arguments(Args, !IO),
    foldl((pred(Arg::in, !.IO::di, !:IO::uo) is det :-
              format("%s => %d\n", [s(Arg), i(from_roman(Arg))], !IO)),
          Args, !IO).

:- end_module test_roman.


MODULE RomanNumerals;
FROM InOut IMPORT WriteString, WriteCard, WriteLn;
FROM Strings IMPORT Length;

(* Convert given Roman numeral to binary *)
PROCEDURE DecodeRoman(s: ARRAY OF CHAR): CARDINAL;
    VAR i, d, len, acc: CARDINAL;

    PROCEDURE Digit(d: CHAR): CARDINAL;
    BEGIN
        CASE CHR( BITSET(ORD(d)) + BITSET{5} ) OF (* lowercase *)
            'm': RETURN 1000;
        |   'd': RETURN 500;
        |   'c': RETURN 100;
        |   'l': RETURN 50;
        |   'x': RETURN 10;
        |   'v': RETURN 5;
        |   'i': RETURN 1;
        ELSE
            RETURN 0;
        END;
    END Digit;
BEGIN
    len := Length(s);
    acc := 0;
    FOR i := 0 TO len-1 DO
        d := Digit(s[i]);
        IF d=0 THEN RETURN 0; END;

        IF (i # len-1) AND (d < Digit(s[i+1])) THEN
            acc := acc - d;
        ELSE
            acc := acc + d;
        END;
    END;
    RETURN acc;
END DecodeRoman;

PROCEDURE Show(s: ARRAY OF CHAR);
BEGIN
    WriteString(s);
    WriteString(": ");
    WriteCard(DecodeRoman(s), 0);
    WriteLn();
END Show;

BEGIN
    Show("MCMXC");
    Show("MDCLXVI");
    Show("mmvii");
    Show("mmxxi");
END RomanNumerals.


def decodeSingle(letter)
	if letter = "M"
		return 1000
	else if letter = "D"
		return 500
	else if letter =  "C"
		return 100
	else if letter = "L"
		return 50
	else if letter = "X"
		return 10
	else if letter = "V"
		return 5
	else if letter = "I"
		return 1
	else
		return 0
	end
end

def decode(roman)
	result = 0
	uRoman = roman.toUpperCase()

	for (i = 0) (i < len(uRoman) - 1) (i += 1)
		if decodeSingle(uRoman[i]) < decodeSingle(uRoman[i + 1])
			result -= decodeSingle(uRoman[i])
		else
			result += decodeSingle(uRoman[i])
		end
	end

	result += decodeSingle(uRoman[len(uRoman) - 1])
	return result
end

println decode("MCMXC")
println decode("MMVIII")
println decode("MDCLXVI")


/* NetRexx */
options replace format comments java crossref savelog symbols binary

           /* 1990  2008   1666    */
years = Rexx('MCMXC MMVIII MDCLXVI')

loop y_ = 1 to years.words
    Say years.word(y_).right(10) || ':' decode(years.word(y_))
    end y_

return

method decode(arg) public static returns int signals IllegalArgumentException

  parse arg.upper roman .
  if roman.verify('MDCLXVI') \= 0 then signal IllegalArgumentException

  -- always insert the value of the least significant numeral
  decnum = rchar(roman.substr(roman.length, 1))
  loop d_ = 1 to roman.length - 1
    if rchar(roman.substr(d_, 1)) < rchar(roman.substr(d_ + 1, 1)) then do
      -- Handle cases where numerals are not in descending order
      --   subtract the value of the numeral
      decnum = decnum - rchar(roman.substr(d_, 1))
      end
    else do
      -- Normal case
      --   add the value of the numeral
      decnum = decnum + rchar(roman.substr(d_, 1))
      end
    end d_

  return decnum

method rchar(arg) public static returns int

  parse arg.upper ch +1 .
  select case ch
    when 'M' then digit = 1000
    when 'D' then digit =  500
    when 'C' then digit =  100
    when 'L' then digit =   50
    when 'X' then digit =   10
    when 'V' then digit =    5
    when 'I' then digit =    1
    otherwise     digit =    0
    end

  return digit


import tables

let rdecode = {'M': 1000, 'D': 500, 'C': 100, 'L': 50, 'X': 10, 'V': 5, 'I': 1}.toTable

proc decode(roman: string): int =
  for i in 0 ..< roman.high:
    let (rd, rd1) = (rdecode[roman[i]], rdecode[roman[i+1]])
    result += (if rd < rd1: -rd else: rd)
  result += rdecode[roman[roman.high]]

for r in ["MCMXC", "MMVIII", "MDCLXVI"]:
  echo r, " ", decode(r)


let decimal_of_roman roman =
  let arabic = ref 0 in
  let lastval = ref 0 in
  for i = (String.length roman) - 1 downto 0 do
    let n =
      match roman.[i] with
      | 'M' | 'm' -> 1000
      | 'D' | 'd' -> 500
      | 'C' | 'c' -> 100
      | 'L' | 'l' -> 50
      | 'X' | 'x' -> 10
      | 'V' | 'v' -> 5
      | 'I' | 'i' -> 1
      | _ -> 0
    in
    if n < !lastval
    then arabic := !arabic - n
    else arabic := !arabic + n;
    lastval := n
  done;
  !arabic

let () =
  Printf.printf " %d\n" (decimal_of_roman "MCMXC");
  Printf.printf " %d\n" (decimal_of_roman "MMVIII");
  Printf.printf " %d\n" (decimal_of_roman "MDCLXVI");
;;


fromRoman(s)={
  my(v=Vecsmall(s),key=vector(88),cur,t=0,tmp);
  key[73]=1;key[86]=5;key[88]=10;key[76]=50;key[67]=100;key[68]=500;key[77]=1000;
  cur=key[v[1]];
  for(i=2,#v,
    tmp=key[v[i]];
    if(!cur, cur=tmp; next);
    if(tmp>cur,
      t+=tmp-cur;
      cur=0
    ,
      t+=cur;
      cur=tmp
    )
  );
  t+cur
};


function romanDec(string s)
    constant romans = "MDCLXVI",
             decmls = {1000,500,100,50,10,5,1}
    integer n, prev = 0, res = 0
    for i=length(s) to 1 by -1 do
        n = decmls[find(s[i],romans)]
        if n<prev then n = 0-n end if
        res += n
        prev = n
    end for
--  return res
    return {s,res} -- (for output)
end function

?apply({"MCMXC","MMVIII","MDCLXVI"},romanDec)


def romanDec   /# s -- n #/
    0 >ps 0 >ps
    ( ( "M" 1000 ) ( "D" 500 ) ( "C" 100 ) ( "L" 50 ) ( "X" 10 ) ( "V" 5 ) ( "I" 1 ) )

    swap upper reverse
    len while
        pop rot rot tochar getd
        if
            dup ps> < if 0 swap - endif
            dup ps> + >ps
            >ps
            swap
        else
            "Error: " print ? ""
        endif
        len
    endwhile
    drop drop
    ps> drop ps>
enddef

/# usage example: "MMXX" romanDec ? (show 2020) #/


<?php
/**
 * @author Elad Yosifon
 */
$roman_to_decimal = array(
	'I' => 1,
	'V' => 5,
	'X' => 10,
	'L' => 50,
	'C' => 100,
	'D' => 500,
	'M' => 1000,
);

/**
 * @param $number
 * @return int
 */
function roman2decimal($number)
{
	global $roman_to_decimal;

	// breaks the string into an array of chars
	$digits = str_split($number);
	$lastIndex = count($digits)-1;
	$sum = 0;

	foreach($digits as $index => $digit)
	{
		if(!isset($digits[$index]))
		{
			continue;
		}

		if(isset($roman_to_decimal[$digit]))
		{
			if($index < $lastIndex)
			{
				$left = $roman_to_decimal[$digits[$index]];
				$right = $roman_to_decimal[$digits[$index+1]];
				if($left < $right)
				{
					$sum += ($right - $left);
					unset($digits[$index+1],$left, $right);
					continue;
				}
				unset($left, $right);
			}
		}
		$sum += $roman_to_decimal[$digit];
	}

	return $sum;
}

/*============= OUTPUT =============*/
header('Content-Type: text/plain');

$tests = array(
	"I" => array(roman2decimal('I'), 1),
	"II" => array(roman2decimal('II'), 2),
	"III" => array(roman2decimal('III'), 3),
	"IV" => array(roman2decimal('IV'), 4),
	"V" => array(roman2decimal('V'), 5),
	"VI" => array(roman2decimal('VI'), 6),
	"VII" => array(roman2decimal('VII'), 7),
	"IX" => array(roman2decimal('IX'), 9),
	"X" => array(roman2decimal('X'), 10),
	"XI" => array(roman2decimal('XI'), 11),
	"XIV" => array(roman2decimal('XIV'), 14),
	"XV" => array(roman2decimal('XV'), 15),
	"XVI" => array(roman2decimal('XVI'), 16),
	"XVIV" => array(roman2decimal('XVIV'), 19),
	"XIX" => array(roman2decimal('XIX'), 19),
	"MDCLXVI" => array(roman2decimal('MDCLXVI'), 1666),
	"MCMXC" => array(roman2decimal('MCMXC'), 1990),
	"MMVIII" => array(roman2decimal('MMVIII'), 2008),
	"MMMCLIX" => array(roman2decimal('MMMCLIX'), 3159),
	"MCMLXXVII" => array(roman2decimal('MCMLXXVII'), 1977),
);

foreach($tests as $key => $value)
{
	echo "($key == {$value[0]}) => " . ($value[0] === $value[1] ? "true" : "false, should be {$value[1]}.") . "\n";
}


go =>
   List = ["IV",
           "XLII",
           "M",
           "MCXI",
           "CMXI",
           "MCM",
           "MCMXC",
           "MMVIII",
           "MMIX",
           "MCDXLIV",
           "MDCLXVI",
           "MMXII"],
   foreach(R in List)
      printf("%-8s: %w\n", R, roman_decode(R))
   end,
   nl.

roman_decode(Str) = Res =>
  if Str == "" then
    Res := ""
  else
    D = new_map(findall((R=D), roman(R,D))),
    Res = 0,
    Old = 0,
    foreach(S in Str)
      N = D.get(S),
      % Fix for the Roman convention that XC = 90, not 110.
      if Old > 0, N > Old then
        Res := Res - 2*Old
      end,
      Res := Res + N,
      Old := N
    end
  end.

roman('I', 1).
roman('V', 5).
roman('X', 10).
roman('L', 50).
roman('C', 100).
roman('D', 500).
roman('M', 1000).


(de roman2decimal (Rom)
   (let L (replace (chop Rom) 'M 1000 'D 500 'C 100 'L 50 'X 10 'V 5 'I 1)
      (sum '((A B) (if (>= A B) A (- A))) L (cdr L)) ) )


test_decode: procedure options (main); /* 28 January 2013 */
   declare roman character (20) varying;

   do roman = 'i', 'ii', 'iii', 'iv', 'v', 'vi', 'vii', 'viii', 'iix',
              'ix', 'x', 'xi', 'xiv', 'MCMLXIV', 'MCMXC', 'MDCLXVI',
              'MIM', 'MM', 'MMXIII';
      put skip list (roman, decode(roman));
   end;

decode: procedure (roman) returns (fixed(15));
   declare roman character (*) varying;
   declare (current, previous) character (1);
   declare n fixed (15);
   declare i fixed binary;

   previous = ''; n = 0;
   do i = length(roman) to 1 by -1;
      current = substr(roman, i, 1);
      if digit_value(current) < digit_value(previous) then
         n = n - digit_value(current);
      else if digit_value(current) > digit_value(previous) then
         do;
            n = n + digit_value(current);
            previous = current;
         end;
      else
         n = n + digit_value(current);
   end;
   return (n);
end decode;

digit_value: procedure (roman_char) returns (fixed);
   declare roman_char character(1);
      select (roman_char);
         when ('M', 'm') return (1000);
         when ('D', 'd') return (500);
         when ('C', 'c') return (100);
         when ('L', 'l') return (50);
         when ('X', 'x') return (10);
         when ('V', 'v') return (5);
         when ('I', 'i') return (1);
         otherwise       return (0);
      end;
end digit_value;

end test_decode;


100H:
/* CP/M CALLS */
BDOS: PROCEDURE (FN, ARG); DECLARE FN BYTE, ARG ADDRESS; GO TO 5; END BDOS;
EXIT: PROCEDURE; CALL BDOS(0,0); END EXIT;
PRINT: PROCEDURE (S); DECLARE S ADDRESS; CALL BDOS(9,S); END PRINT;

/* CP/M COMMAND LINE ARGUMENT */
DECLARE ARG$LPTR ADDRESS INITIAL (80H), ARG$LEN BASED ARG$LPTR BYTE;
DECLARE ARG$PTR  ADDRESS INITIAL (81H), ARG     BASED ARG$PTR BYTE;

/* CONVERT ROMAN NUMERAL TO BINARY */
READ$ROMAN: PROCEDURE (RP) ADDRESS;
    DECLARE DIGITS (7) BYTE INITIAL ('MDCLXVI');
    DECLARE VALUES (7) ADDRESS INITIAL (1000,500,100,50,10,5,1);
    DECLARE (RP, V, DVAL) ADDRESS, R BASED RP BYTE;
    V = 0;

    GET$DIGIT: PROCEDURE (D) ADDRESS;
        DECLARE (D, I) BYTE;
        DO I = 0 TO LAST(DIGITS);
            IF DIGITS(I) = D THEN RETURN VALUES(I);
        END;
        RETURN 0; /* NOT FOUND */
    END GET$DIGIT;

    DO WHILE R <> '$';
        DVAL = GET$DIGIT(R);
        IF DVAL = 0 THEN RETURN 0; /* ERROR */
        RP = RP + 1;
        IF GET$DIGIT(R) > DVAL THEN
            V = V - DVAL; /* SUBTRACTIVE PRINCIPLE */
        ELSE
            V = V + DVAL;
    END;
    RETURN V;
END READ$ROMAN;

/* PRINT BINARY NUMBER AS DECIMAL */
PRINT$NUMBER: PROCEDURE (N);
    DECLARE S (6) BYTE INITIAL ('.....$');
    DECLARE (N, P) ADDRESS, C BASED P BYTE;
    P = .S(5);
DIGIT:
    P = P - 1;
    C = N MOD 10 + '0';
    N = N / 10;
    IF N > 0 THEN GO TO DIGIT;
    CALL PRINT(P);
END PRINT$NUMBER;

IF ARG$LEN = 0 THEN DO;
    CALL PRINT(.'NO INPUT$');
    CALL EXIT;
END;

ARG(ARG$LEN) = '$';  /* TERMINATE ARGUMENT STRING */
CALL PRINT(.ARG(1)); /* PRINT ROMAN NUMERAL */
CALL PRINT(.': $');
CALL PRINT$NUMBER(READ$ROMAN(.ARG(1))); /* CONVERT AND PRINT VALUE */
CALL EXIT;
EOF


/*****************************************************************
 * $Author: Atanas Kebedjiev $
 *****************************************************************
 * PL/SQL code can be run as anonymous block.
 * To test, execute the whole script or create the functions and then e.g. 'select rdecode('2012') from dual;
 * Please note that task definition does not describe fully some current rules, such as
 * * subtraction - IX XC CM are the valid subtraction combinations
 * * A subtraction character cannot be repeated: 8 is expressed as VIII and not as IIX
 * * V L and D cannot be used for subtraction
 * * Any numeral cannot be repeated more than 3 times: 1910 should be MCMX and not MDCCCCX
 * Code below does not validate the Roman numeral itself and will return a result even for a non-compliant number
 * E.g. both MCMXCIX and IMM will return 1999 but the first one is the correct notation
 */

DECLARE

FUNCTION rvalue(c IN CHAR) RETURN NUMBER IS
    i INTEGER;
BEGIN
    i := 0;
    CASE (c)
        when 'M' THEN i := 1000;
        when 'D' THEN i := 500;
        when 'C' THEN i := 100;
        when 'L' THEN i := 50;
        when 'X' THEN i := 10;
        when 'V' THEN i := 5;
        when 'I' THEN i := 1;
    END CASE;
    RETURN i;
END;

FUNCTION decode(rn IN VARCHAR2) RETURN NUMBER IS
   i  INTEGER;
   l  INTEGER;
   cr CHAR;   -- current Roman numeral as substring from r
   cv INTEGER; -- value of current Roman numeral

   gr CHAR;   -- next Roman numeral
   gv NUMBER; --  value of the next numeral;

   dv NUMBER; -- decimal value to return
BEGIN
           l := length(rn);
           i := 1;
           dv := 0;
           while (i <= l)
           LOOP
                cr := substr(rn,i,1);
                cv := rvalue(cr);

   /* Look for a larger numeral in next position, like IV or CM
      The number to subtract should be at least 1/10th of the bigger number
      CM and XC are valid, but IC and XM are not */
                IF (i < l) THEN
                   gr := substr(rn,i+1,1);
                   gv := rvalue(gr);
                   IF (cv < gv ) THEN
                      dv := dv - cv;
                   ELSE
                      dv := dv + cv;
                   END IF;
                ELSE
                   dv := dv + cv;
                END IF;  -- need to add the last value unconditionally

                i := i + 1;
            END LOOP;

RETURN dv;

END;

BEGIN

    DBMS_OUTPUT.PUT_LINE ('MMXII      = ' || rdecode('MMXII'));       -- 2012
    DBMS_OUTPUT.PUT_LINE ('MCMLI      = ' || rdecode('MCMLI'));       -- 1951
    DBMS_OUTPUT.PUT_LINE ('MCMLXXXVII = ' || rdecode('MCMLXXXVII'));  -- 1987
    DBMS_OUTPUT.PUT_LINE ('MDCLXVI    = ' || rdecode('MDCLXVI'));     -- 1666
    DBMS_OUTPUT.PUT_LINE ('MCMXCIX    = ' || rdecode('MCMXCIX'));     -- 1999

END;


Filter FromRoman {
	$output = 0

	if ($_ -notmatch '^(M{1,3}|)(CM|CD|D?C{0,3}|)(XC|XL|L?X{0,3}|)(IX|IV|V?I{0,3}|)$') {
		throw 'Incorrect format'
	}

	$current = 1000
	$subtractor = 'M'
	$whole = $False
	$roman = $_
	'C','D','X','L','I','V',' ' `
	| %{
		if ($whole = !$whole) {
			$current /= 10
			$subtractor = $_ + $subtractor[0]
			$_ = $subtractor[1]
		}
		else {
			$subtractor = $subtractor[0] + $_
		}

		if ($roman -match $subtractor) {
			$output += $current * (4,9)[$whole]
			$roman = $roman -replace $subtractor,''
		}
		if ($roman -match ($_ + '{1,3}')) {
			$output += $current * (5,10)[$whole] * $Matches[0].Length
		}
	}

	$output
}


decode_digit(i, 1).
decode_digit(v, 5).
decode_digit(x, 10).
decode_digit(l, 50).
decode_digit(c, 100).
decode_digit(d, 500).
decode_digit(m, 1000).

decode_string(Sum, _, [], Sum).

decode_string(LastSum, LastValue, [Digit|Rest], NextSum) :-
   decode_digit(Digit, Value),
   Value < LastValue,
   Sum is LastSum - Value,
   decode_string(Sum, Value, Rest, NextSum).

decode_string(LastSum, LastValue, [Digit|Rest], NextSum) :-
   decode_digit(Digit, Value),
   Value >= LastValue,
   Sum is LastSum + Value,
   decode_string(Sum, Value, Rest, NextSum).

decode_string(Atom, Value) :-
   atom_chars(Atom, String),
   reverse(String, [Last|Rest]),
   decode_digit(Last, Start),
   decode_string(Start, Start, Rest, Value).

test :-
   decode_string(mcmxc, 1990),
   decode_string(mmviii, 2008),
   decode_string(mdclxvi, 1666).


Procedure romanDec(roman.s)
  Protected i, n, lastval, arabic

  For i = Len(roman) To 1 Step -1
    Select UCase(Mid(roman, i, 1))
      Case "M"
        n = 1000
      Case "D"
        n = 500
      Case "C"
        n = 100
      Case "L"
        n = 50
      Case "X"
        n = 10
      Case "V"
        n = 5
      Case "I"
        n = 1
      Default
        n = 0
    EndSelect
    If (n < lastval)
      arabic - n
    Else
      arabic + n
    EndIf
    lastval = n
  Next

  ProcedureReturn arabic
EndProcedure

If OpenConsole()
  PrintN(Str(romanDec("MCMXCIX"))) ;1999
  PrintN(Str(romanDec("MDCLXVI"))) ;1666
  PrintN(Str(romanDec("XXV")))     ;25
  PrintN(Str(romanDec("CMLIV")))   ;954
  PrintN(Str(romanDec("MMXI")))    ;2011

  Print(#CRLF$ + #CRLF$ + "Press ENTER to exit"): Input()
  CloseConsole()
EndIf


_rdecode = dict(zip('MDCLXVI', (1000, 500, 100, 50, 10, 5, 1)))

def decode( roman ):
    result = 0
    for r, r1 in zip(roman, roman[1:]):
        rd, rd1 = _rdecode[r], _rdecode[r1]
        result += -rd if rd < rd1 else rd
    return result + _rdecode[roman[-1]]

if __name__ == '__main__':
    for r in 'MCMXC MMVIII MDCLXVI'.split():
        print( r, decode(r) )


FUNCTION romToDec (roman$)
    num = 0
    prenum = 0
    FOR i = LEN(roman$) TO 1 STEP -1
        x$ = MID$(roman$, i, 1)
        n = 0
        IF x$ = "M" THEN n = 1000
        IF x$ = "D" THEN n = 500
        IF x$ = "C" THEN n = 100
        IF x$ = "L" THEN n = 50
        IF x$ = "X" THEN n = 10
        IF x$ = "V" THEN n = 5
        IF x$ = "I" THEN n = 1

        IF n < preNum THEN num = num - n ELSE num = num + n
        preNum = n
    NEXT i

    romToDec = num
END FUNCTION

!Testing
PRINT "MCMXCIX = "; romToDec("MCMXCIX")     '1999
PRINT "MDCLXVI = "; romToDec("MDCLXVI")     '1666
PRINT "XXV     = "; romToDec("XXV")         '25
PRINT "CMLIV   = "; romToDec("CMLIV")       '954
PRINT "MMXI    = "; romToDec("MMXI")        '2011


  [ 2dup <
    if
      [ dip
          [ 2 * - ]
        dup ]
    nip dup
    rot + swap ] is roman    ( t p n --> t p )

  [    1 roman ] is I        (   t p --> t p )
  [    5 roman ] is V        (   t p --> t p )
  [   10 roman ] is X        (   t p --> t p )
  [   50 roman ] is L        (   t p --> t p )
  [  100 roman ] is C        (   t p --> t p )
  [  500 roman ] is D        (   t p --> t p )
  [ 1000 roman ] is M        (   t p --> t p )

  [ 0 1000 rot
    $ "" swap
    witheach
      [ space join
        join ]
    quackery
    drop ]       is ->arabic (     $ --> n   )

  $ "  MCMXC" dup echo$ say " = " ->arabic echo cr
  $ " MMVIII" dup echo$ say " = " ->arabic echo cr
  $ "MDCLXVI" dup echo$ say " = " ->arabic echo cr
  cr
  $ "I MIX VIVID MILD MIMIC"
               dup echo$ say " = " ->arabic echo cr


SCREEN _NEWIMAGE(400, 600, 32)

CLS

Main:
'------------------------------------------------
' CALLS THE romToDec FUNCTION WITH THE ROMAN
' NUMERALS AND RETURNS ITS DECIMAL EQUIVELENT.
'
   PRINT "ROMAN NUMERAL TO DECIMAL CONVERSION"
   PRINT: PRINT

   PRINT "MDCCIV  = "; romToDec("MDCCIV") '1704
   PRINT "MCMXC   = "; romToDec("MCMXC") '1990
   PRINT "MMVIII  = "; romToDec("MMVIII") '2008
   PRINT "MDCLXVI = "; romToDec("MDCLXVI") '1666
   PRINT: PRINT
   PRINT "Here are other solutions not from the TASK:"
   PRINT "MCMXCIX = "; romToDec("MCMXCIX") '1999
   PRINT "XXV     = "; romToDec("XXV") '25
   PRINT "CMLIV   = "; romToDec("CMLIV") '954
   PRINT "MMXI    = "; romToDec("MMXI") '2011
   PRINT "MMIIIX  = "; romToDec("MMIIIX") '2011
   PRINT: PRINT
   PRINT "2011 can be written either as MMXI or MMIIIX"
   PRINT "With the IX = 9, MMIIIX is also 2011."
   PRINT "2011 IS CORRECT (MM=2000 + II = 2 + IX = 9)"

   END

FUNCTION romToDec (roman AS STRING)
'------------------------------------------------------
' FUNCTION THAT CONVERTS ANY ROMAN NUMERAL TO A DECIMAL
'
    prenum = 0: num = 0
    LN = LEN(roman)
    FOR i = LN TO 1 STEP -1
        x$ = MID$(roman, i, 1)
        n = 1000
        SELECT CASE x$
               CASE "M": n = n / 1
               CASE "D": n = n / 2
               CASE "C": n = n / 10
               CASE "L": n = n / 20
               CASE "X": n = n / 100
               CASE "V": n = n / 200
               CASE "I": n = n / n
               CASE ELSE: n = 0
        END SELECT
        IF n < prenum THEN num = num - n ELSE num = num + n
        prenum = n
   NEXT i

   romToDec = num

END FUNCTION


romanToArabic <- function(roman) {
  romanLookup <- c(I=1L, V=5L, X=10L, L=50L, C=100L, D=500L, M=1000L)
  rSplit <- strsplit(toupper(roman), character(0)) # Split input vector into characters
  toArabic <- function(item) {
    digits <- romanLookup[item]
    if (length(digits) > 1L) {
      smaller <- (digits[-length(digits)] < digits[-1L])
      digits[smaller] <- - digits[smaller]
    }
    sum(digits)
  }
  vapply(rSplit, toArabic, integer(1))
}


#lang racket
(define (decode/roman number)
  (define letter-values
    (map cons '(#\M #\D #\C #\L #\X #\V #\I) '(1000 500 100 50 10 5 1)))
  (define (get-value letter)
    (cdr (assq letter letter-values)))
  (define lst (map get-value (string->list number)))
  (+ (last lst)
     (for/fold ((sum 0))
       ((i (in-list lst)) (i+1 (in-list (cdr lst))))
       (+ sum
          (if (> i+1 i)
              (- i)
              i)))))

(map decode/roman '("MCMXC" "MMVIII" "MDCLXVI"))
;-> '(1990 2008 1666)


sub rom-to-num($r) {
    [+] gather $r.uc ~~ /
        ^
        [
        | M  { take 1000 }
        | CM { take 900 }
        | D  { take 500 }
        | CD { take 400 }
        | C  { take 100 }
        | XC { take 90 }
        | L  { take 50 }
        | XL { take 40 }
        | X  { take 10 }
        | IX { take 9 }
        | V  { take 5 }
        | IV { take 4 }
        | I  { take 1 }
        ]+
        $
    /;
}

say "$_ => &rom-to-num($_)" for <MCMXC MDCLXVI MMVIII>;


Red [
    Purpose: "Arabic <-> Roman numbers converter"
    Author: "Didier Cadieu"
    Date: "07-Oct-2016"
]

table-r2a: reverse [1000 "M" 900 "CM" 500 "D" 400 "CD" 100 "C" 90 "XC" 50 "L" 40 "XL" 10 "X" 9 "IX" 5 "V" 4 "IV" 1 "I"]

roman-to-arabic: func [r [string!] /local a b e] [
	a: 0
	parse r [any [b: ["I" ["V" | "X" | none] | "X" ["L" | "C" | none] | "C" ["D" | "M" | none] | "V" | "L" | "D" | "M"] e: (a: a + select table-r2a copy/part b e)]]
	a
]

; Example usage:
print roman-to-arabic "XXXIII"
print roman-to-arabic "MDCCCLXXXVIII"
print roman-to-arabic "MMXVI"


/* Rexx */

Do
        /* 1990  2008   1666    */
  years = 'MCMXC MMVIII MDCLXVI'

  Do y_ = 1 to words(years)
    Say right(word(years, y_), 10) || ':' decode(word(years, y_))
    End y_

  Return
End
Exit

decode:
  Procedure
Do
  Parse upper arg roman .

  If verify(roman, 'MDCLXVI') = 0 then Do

    /* always insert the value of the least significant numeral */
    decnum = rchar(substr(roman, length(roman), 1))
    Do d_ = 1 to length(roman) - 1
      If rchar(substr(roman, d_, 1)) < rchar(substr(roman, d_ + 1, 1)) then Do
        /* Handle cases where numerals are not in descending order */
        /*   subtract the value of the numeral */
        decnum = decnum - rchar(substr(roman, d_, 1))
        End
      else Do
        /* Normal case */
        /*   add the value of the numeral */
        decnum = decnum + rchar(substr(roman, d_, 1))
        End
      End d_
    End
  else Do
    decnum = roman 'contains invalid roman numerals'
    End

  Return decnum
End
Exit

rchar:
  Procedure
Do
  Parse upper arg ch +1 .

  select
    when ch = 'M' then digit = 1000
    when ch = 'D' then digit =  500
    when ch = 'C' then digit =  100
    when ch = 'L' then digit =   50
    when ch = 'X' then digit =   10
    when ch = 'V' then digit =    5
    when ch = 'I' then digit =    1
    otherwise          digit =    0
    end

  Return digit
End
Exit


symbols = "MDCLXVI"
weights = [1000,500,100,50,10,5,1]

see "MCMXCIX = " + romanDec("MCMXCIX") + nl
see "MDCLXVI =" + romanDec("MDCLXVI") + nl
see "XXV = " + romanDec("XXV") + nl
see "CMLIV = " + romanDec("CMLIV") + nl
see "MMXI = " + romanDec("MMXI") + nl

func romanDec roman
     n = 0
     lastval = 0
     arabic = 0
     for i = len(roman) to 1 step -1
         n = substr(symbols,roman[i])
         if n > 0 n = weights[n] ok
         if n < lastval arabic = arabic - n
         else arabic = arabic + n ok
         lastval = n
     next
     return arabic


def fromRoman(roman)
  r = roman.upcase
  n = 0
  until r.empty? do
    case
    when r.start_with?('M')  then v = 1000; len = 1
    when r.start_with?('CM') then v = 900;  len = 2
    when r.start_with?('D')  then v = 500;  len = 1
    when r.start_with?('CD') then v = 400;  len = 2
    when r.start_with?('C')  then v = 100;  len = 1
    when r.start_with?('XC') then v = 90;   len = 2
    when r.start_with?('L')  then v = 50;   len = 1
    when r.start_with?('XL') then v = 40;   len = 2
    when r.start_with?('X')  then v = 10;   len = 1
    when r.start_with?('IX') then v = 9;    len = 2
    when r.start_with?('V')  then v = 5;    len = 1
    when r.start_with?('IV') then v = 4;    len = 2
    when r.start_with?('I')  then v = 1;    len = 1
    else
      raise ArgumentError.new("invalid roman numerals: " + roman)
    end
    n += v
    r.slice!(0,len)
  end
  n
end

[ "MCMXC", "MMVIII", "MDCLXVI" ].each {|r| p r => fromRoman(r)}


print "MCMXCIX = "; romToDec( "MCMXCIX") '1999
print "MDCLXVI = "; romToDec( "MDCLXVI") '1666
print "XXV     = "; romToDec( "XXV")     '25
print "CMLIV   = "; romToDec( "CMLIV")   '954
print "MMXI    = "; romToDec( "MMXI")    '2011

function romToDec(roman$)
  for i  = len(roman$) to 1 step -1
   x$    = mid$(roman$, i, 1)
   n     = 0
   if x$ = "M" then n = 1000
   if x$ = "D" then n = 500
   if x$ = "C" then n = 100
   if x$ = "L" then n = 50
   if x$ = "X" then n = 10
   if x$ = "V" then n = 5
   if x$ = "I" then n = 1

  if n < preNum then num = num - n else num = num + n
  preNum = n
  next

  romToDec =num
end function


struct RomanNumeral {
    symbol: &'static str,
    value: u32
}

const NUMERALS: [RomanNumeral; 13] = [
    RomanNumeral {symbol: "M",  value: 1000},
    RomanNumeral {symbol: "CM", value: 900},
    RomanNumeral {symbol: "D",  value: 500},
    RomanNumeral {symbol: "CD", value: 400},
    RomanNumeral {symbol: "C",  value: 100},
    RomanNumeral {symbol: "XC", value: 90},
    RomanNumeral {symbol: "L",  value: 50},
    RomanNumeral {symbol: "XL", value: 40},
    RomanNumeral {symbol: "X",  value: 10},
    RomanNumeral {symbol: "IX", value: 9},
    RomanNumeral {symbol: "V",  value: 5},
    RomanNumeral {symbol: "IV", value: 4},
    RomanNumeral {symbol: "I",  value: 1}
];

fn to_hindu(roman: &str) -> u32 {
    match NUMERALS.iter().find(|num| roman.starts_with(num.symbol)) {
        Some(num) => num.value + to_hindu(&roman[num.symbol.len()..]),
        None => 0, // if string empty, add nothing
    }
}

fn main() {
    let roms = ["MMXIV", "MCMXCIX", "XXV", "MDCLXVI", "MMMDCCCLXXXVIII"];
    for &r in &roms {
        // 15 is minimum formatting width of the first argument, there for alignment
        println!("{:2$} = {}", r, to_hindu(r), 15);
    }
}


def fromRoman( r:String ) : Int = {
  val arabicNumerals = List("CM"->900,"M"->1000,"CD"->400,"D"->500,"XC"->90,"C"->100,
                            "XL"->40,"L"->50,"IX"->9,"X"->10,"IV"->4,"V"->5,"I"->1)

  var s = r
  arabicNumerals.foldLeft(0){ (n,t) => {
    val l = s.length; s = s.replaceAll(t._1,""); val c = (l - s.length)/t._1.length  // Get the frequency
    n + (c*t._2)  // Add the arabic numerals up
  } }
}

// Here is a another version that does a simple running sum:
def fromRoman2(s: String) : Int = {
    val numerals = Map('I' -> 1, 'V' -> 5, 'X' -> 10, 'L' -> 50, 'C' -> 100, 'D' -> 500, 'M' -> 1000)

    s.toUpperCase.map(numerals).foldLeft((0,0)) {
      case ((sum, last), curr) =>  (sum + curr + (if (last < curr) -2*last else 0), curr) }._1
  }
}

// A small test
def test( roman:String ) = println( roman + " => " + fromRoman( roman ) )

test("MCMXC")
test("MMVIII")
test("MDCLXVI")


(use gauche.collection) ;; for fold2

(define (char-val char)
  (define i (string-scan "IVXLCDM" char))
  (* (expt 10 (div i 2)) (expt 5 (mod i 2))))

(define (decode roman)
  (fold2
    (lambda (n sum prev-val)
      (values ((if (< n prev-val) - +) sum n) (max n prev-val)))
    0 0
    (map char-val (reverse (string->list roman)))))


$ include "seed7_05.s7i";

const func integer: ROMAN parse (in string: roman) is func
  result
    var integer: arabic is 0;
  local
    var integer: index is 0;
    var integer: number is 0;
    var integer: lastval is 0;
  begin
    for index range length(roman) downto 1 do
      case roman[index] of
        when {'M', 'm'}: number := 1000;
        when {'D', 'd'}: number :=  500;
        when {'C', 'c'}: number :=  100;
        when {'L', 'l'}: number :=   50;
        when {'X', 'x'}: number :=   10;
        when {'V', 'v'}: number :=    5;
        when {'I', 'i'}: number :=    1;
        otherwise:       raise RANGE_ERROR;
      end case;
      if number < lastval then
        arabic -:= number;
      else
        arabic +:= number;
      end if;
      lastval := number;
    end for;
  end func;

const proc: main is func
  begin
    writeln(ROMAN parse "MCMXC");
    writeln(ROMAN parse "MMVIII");
    writeln(ROMAN parse "MDCLXVI");
  end func;


function RomanNumeralsDecode numerals
	put {
		"M": 1000,
		"D": 500,
		"C": 100,
		"L": 50,
		"X": 10,
		"V": 5,
		"I": 1
	} into values

	put 0 into total
	repeat with each character letter of numerals
		if values.(character the counter + 1 of numerals) is less than or equal to values.(letter)
			add values.(letter) to total
		else
			subtract values.(letter) from total
		end if
	end repeat
	return total
end RomanNumeralsDecode


func roman2arabic(roman) {

    var arabic = 0
    var last_digit = 1000

    static m = Hash(
        I =>    1,
        V =>    5,
        X =>   10,
        L =>   50,
        C =>  100,
        D =>  500,
        M => 1000,
    )

    roman.uc.chars.map{m{_} \\ 0}.each { |digit|
        if (last_digit < digit) {
            arabic -= (2 * last_digit)
        }
        arabic += (last_digit = digit)
    }

    return arabic
}

%w(MCMXC MMVIII MDCLXVI).each { |roman_digit|
    "%-10s == %d\n".printf(roman_digit, roman2arabic(roman_digit))
}


BEGIN

    INTEGER PROCEDURE FROMROMAN(S); TEXT S;
    BEGIN
        PROCEDURE P(INTVAL, NUM); INTEGER INTVAL; TEXT NUM;
        BEGIN
            INTEGER NLEN;
            NLEN := NUM.LENGTH;
            WHILE INDEX + NLEN - 1 <= SLEN AND THEN
                S.SUB(INDEX, NLEN) = NUM DO
            BEGIN
                RESULT := RESULT + INTVAL;
                INDEX := INDEX + NLEN;
            END WHILE;
        END P;
        INTEGER RESULT, INDEX, SLEN;
        SLEN := S.LENGTH;
        INDEX := 1;
        P( 1000, "M"  );
        P(  900, "CM" );
        P(  500, "D"  );
        P(  400, "CD" );
        P(  100, "C"  );
        P(   90, "XC" );
        P(   50, "L"  );
        P(   40, "XL" );
        P(   10, "X"  );
        P(    9, "IX" );
        P(    5, "V"  );
        P(    4, "IV" );
        P(    1, "I"  );
        FROMROMAN := RESULT;
    END FROMROMAN;

    TEXT T;
    FOR T :- "MCMXC", "MMVIII", "MDCLXVI" DO
    BEGIN
        OUTTEXT("ROMAN """);
        OUTTEXT(T);
        OUTTEXT(""" => ");
        OUTINT(FROMROMAN(T), 0);
        OUTIMAGE;
    END FOR;

END PROGRAM;


*        Roman to Arabic
        define('arabic(n)s,ch,val,sum,x') :(arabic_end)
arabic  s = 'M1000 D500 C100 L50 X10 V5 I1 '
        n = reverse(n)
arab1   n len(1) . ch = :f(arab2)
        s ch break(' ') . val
        val = lt(val,x) (-1 * val)
        sum = sum + val; x = val        :(arab1)
arab2   arabic = sum                    :(return)
arabic_end

*        Test and display
        tstr = 'MMX MCMXCIX MCDXCII MLXVI CDLXXVI "
tloop   tstr break(' ') . r span(' ') = :f(out)
        astr = astr r '=' arabic(r) ' ' :(tloop)
out     output = astr
end


extension Int {
    init(romanNumerals: String) {
        let values = [
            ( "M", 1000),
            ("CM",  900),
            ( "D",  500),
            ("CD",  400),
            ( "C",  100),
            ("XC",   90),
            ( "L",   50),
            ("XL",   40),
            ( "X",   10),
            ("IX",    9),
            ( "V",    5),
            ("IV",    4),
            ( "I",    1),
        ]

        self = 0
        var raw = romanNumerals
        for (digit, value) in values {
            while raw.hasPrefix(digit) {
                self += value
                raw.removeFirst(digit.count)
            }
        }
    }
}


def digits: [(M:1000"1"), (CM:900"1"), (D:500"1"), (CD:400"1"), (C:100"1"), (XC:90"1"), (L:50"1"), (XL:40"1"), (X:10"1"), (IX:9"1"), (V:5"1"), (IV:4"1"), (I:1"1")];
composer decodeRoman
  @: 1;
  [ <digit>* ] -> \(@: 0; $... -> @: [email protected] + $; [email protected] !\)
  rule digit: <value>* (@: [email protected] + 1;)
  rule value: <='$digits([email protected])::key;'> -> $digits([email protected])::value
end decodeRoman

'MCMXC' -> decodeRoman -> !OUT::write
'
' -> !OUT::write
'MMVIII' -> decodeRoman -> !OUT::write
'
' -> !OUT::write
'MDCLXVI' -> decodeRoman -> !OUT::write


proc fromRoman rnum {
    set map {M 1000+ CM 900+ D 500+ CD 400+ C 100+ XC 90+ L 50+ XL 40+ X 10+ IX 9+ V 5+ IV 4+ I 1+}
    expr [string map $map $rnum]0}
}


Main:
!------------------------------------------------
! CALLS THE romToDec FUNCTION WITH THE ROMAN
! NUMERALS AND RETURNS ITS DECIMAL EQUIVELENT.
!

   PRINT "MCMXC   = "; romToDec("MCMXC")   !1990
   PRINT "MMVIII  = "; romToDec("MMVIII")  !2008
   PRINT "MDCLXVI = "; romToDec("MDCLXVI") !1666
   PRINT:PRINT
   PRINT "Here are other solutions not from the TASK:"
   PRINT "MCMXCIX = "; romToDec("MCMXCIX") !1999
   PRINT "XXV     = "; romToDec("XXV")     !25
   PRINT "CMLIV   = "; romToDec("CMLIV")   !954
   PRINT "MMXI    = "; romToDec("MMXI")    !2011
   PRINT:PRINT
   PRINT "Without error checking, this also is 2011, but is wrong"
   PRINT "MMIIIX  = "; romToDec("MMIIIX")  !INVAID, 2011

STOP

FUNCTION romToDec(roman AS STRING) AS INTEGER
!------------------------------------------------------
! FUNCTION THAT CONVERTS ANY ROMAN NUMERAL TO A DECIMAL
!
    prenum=0!num=0
    ln=LEN(roman)
    FOR i=ln TO 1 STEP -1
        x$=MID(roman,i,1)
        n=1000
        SELECT CASE x$
               CASE "M":n=n/1
               CASE "D":n=n/2
               CASE "C":n=n/10
               CASE "L":n=n/20
               CASE "X":n=n/100
               CASE "V":n=n/200
               CASE "I":n=n/n
               CASE ELSE:n=0
        END SELECT
        IF n < preNum THEN num=num-n ELSE num=num+n
        preNum=n
   next i

   romToDec=num

END FUNCTION


PROGRAM:ROM2DEC
:Input Str1
:Disp real(21,Str1)


FUNCTION romtodec(roman$)
    LET num = 0
    LET prenum = 0
    FOR i = LEN(roman$) TO 1 STEP -1
        LET x$ = (roman$)[i:i+1-1]
        LET n = 0
        IF x$ = "M" THEN LET n = 1000
        IF x$ = "D" THEN LET n = 500
        IF x$ = "C" THEN LET n = 100
        IF x$ = "L" THEN LET n = 50
        IF x$ = "X" THEN LET n = 10
        IF x$ = "V" THEN LET n = 5
        IF x$ = "I" THEN LET n = 1
        IF n < prenum THEN LET num = num-n ELSE LET num = num+n
        LET prenum = n
    NEXT i

    LET romtodec = num
END FUNCTION

!Testing
PRINT "MCMXCIX = "; romToDec("MCMXCIX")     !1999
PRINT "MDCLXVI = "; romToDec("MDCLXVI")     !1666
PRINT "XXV     = "; romToDec("XXV")         !25
PRINT "CMLIV   = "; romToDec("CMLIV")       !954
PRINT "MMXI    = "; romToDec("MMXI")        !2011
END


$$ MODE TUSCRIPT
LOOP roman_number="MCMXC'MMVIII'MDCLXVI"
arab_number=DECODE (roman_number,ROMAN)
PRINT "Roman number ",roman_number," equals ", arab_number
ENDLOOP


#!/bin/bash

roman_to_dec() {
  local rnum=$1
  local n=0
  local prev=0

  for ((i=${#rnum}-1;i>=0;i--))
  do
    case "${rnum:$i:1}" in
    M)  a=1000 ;;
    D)  a=500 ;;
    C)  a=100 ;;
    L)  a=50 ;;
    X)  a=10 ;;
    V)  a=5 ;;
    I)  a=1 ;;
    esac

    if [[ $a -lt $prev ]]
    then
       let n-=a
    else
       let n+=a
    fi

    prev=$a
  done

  echo "$rnum = $n"
}

roman_to_dec MCMXC
roman_to_dec MMVIII
roman_to_dec MDCLXVI


Option Explicit

Sub Main_Romans_Decode()
Dim Arr(), i&

    Arr = Array("III", "XXX", "CCC", "MMM", "VII", "LXVI", "CL", "MCC", "IV", "IX", "XC", "ICM", "DCCCXCIX", "CMI", "CIM", "MDCLXVI", "MCMXC", "MMXVII")
    For i = 0 To UBound(Arr)
        Debug.Print Arr(i) & "   >>> " & lngConvert(CStr(Arr(i)))
    Next
End Sub

Function Convert(Letter As String) As Long
Dim Romans(), DecInt(), Pos As Integer

    Romans = Array("M", "D", "C", "L", "X", "V", "I")
    DecInt = Array(1000, 500, 100, 50, 10, 5, 1)
    Pos = -1
    On Error Resume Next
    Pos = Application.Match(Letter, Romans, 0) - 1
    On Error GoTo 0
    If Pos <> -1 Then Convert = DecInt(Pos)
End Function

Function lngConvert(strRom As String) 'recursive function
Dim i As Long, iVal As Integer

    If Len(strRom) = 1 Then
        lngConvert = Convert(strRom)
    Else
        iVal = Convert(Mid(strRom, 1, 1))
        If iVal < Convert(Mid(strRom, 2, 1)) Then iVal = iVal * (-1)
        lngConvert = iVal + lngConvert(Mid(strRom, 2, Len(strRom) - 1))
    End If
End Function


' Roman numerals Encode - Visual Basic - 18/04/2019

Function toRoman(ByVal value)
    Dim arabic
    Dim roman
    Dim i, result
    arabic = Array(1000, 900, 500, 400, 100, 90, 50, 40, 10, 9, 5, 4, 1)
    roman = Array("M", "CM", "D", "CD", "C", "XC", "L", "XL", "X", "IX", "V", "IV", "I")
    For i = 0 To 12
        Do While value >= arabic(i)
            result = result + roman(i)
            value = value - arabic(i)
        Loop
    Next 'i
    toRoman = result
End Function 'toRoman

    n=InputBox("Number, please","Roman numerals/Encode")
    code=MsgBox(n & vbCrlf & toRoman(n),vbOKOnly+vbExclamation,"Roman numerals/Encode")
	If code=vbOK Then ok=1


// Main program for testing the function
//
do {
    Get_Input(10, "Enter a roman numeral: ", NOCR+STATLINE)
    Call("Roman_to_Arabic")
    Reg_Type(10) Message("	= ") Num_Type(#1)
} while(#1)
Return

// Convert Roman numeral into numeric value
//  in:  @10 = Roman numeral
//  out: #1  = numeric value
//
:Roman_to_Arabic:
    Buf_Switch(Buf_Free)
    Ins_Text("M1000 D500 C100 L50 X10 V5 I1") Ins_Newline
    Reg_Ins(10) Ins_Char(' ')
    #1 = #2 = 0

    Repeat(ALL) {
        #3 = #2                                  // #3 = previous character
        Goto_Line(2)                             // roman numeral to be converted
        if (At_EOL) {
            Break                                // all done
        }
        Reg_Copy_Block(11, CP, CP+1, DELETE)     // next character in roman numeral
        if (Search(@11, BEGIN+ADVANCE+NOERR)) {  // find character from the table
            #2 = Num_Eval(SUPPRESS)              // corresponding numeric value
            if (#2 > #3) {                       // larger than previous digit?
                #1 -= #3                         // substract previous digit
            } else {
                #1 += #3                         // add previous digit
            }
        }
    }
    Reg_Empty(11)
    Buf_Quit(OK)
Return


import "/fmt" for Fmt

var decode = Fn.new { |r|
    if (r == "") return 0
    var n = 0
    var last = "0"
    for (c in r) {
        var k
        if (c == "I") {
            k = 1
        } else if (c == "V") {
            k = (last == "I") ? 3 : 5
        } else if (c == "X") {
            k = (last == "I") ? 8 : 10
        } else if (c == "L") {
            k = (last == "X") ? 30 : 50
        } else if (c == "C") {
            k = (last == "X") ? 80 : 100
        } else if (c == "D") {
            k = (last == "C") ? 300 : 500
        } else if (c == "M") {
            k = (last == "C") ? 800 : 1000
        }
        n = n + k
        last = c
    }
    return n
}

var romans = ["I", "III", "IV", "VIII", "XLIX", "CCII", "CDXXXIII", "MCMXC", "MMVIII", "MDCLXVI"]
for (r in romans) System.print("%(Fmt.s(-10, r)) = %(decode.call(r))")


(defun decode (r)
    (define roman '((#\m 1000) (#\d 500) (#\c 100) (#\l 50) (#\x 10) (#\v 5) (#\i 1)))
    (defun to-arabic (rn rs a)
        (cond
            ((null rn) a)
            ((eqv? (car rn) (caar rs)) (to-arabic (cdr rn) roman (if (and (not (eqv? (car rn) (cadr rn))) (< (cadar rs) (to-arabic (cdr rn) roman 0)))
                (- a (cadar rs))
                (+ a (cadar rs)) ) ) )
            (t (to-arabic rn (cdr rs) a)) ) )
    (to-arabic (string->list r) roman 0) )


string 0;                       \use zero-terminated strings
code CrLf=9, IntOut=11;

func Roman(Str);                \Convert Roman numeral string to decimal value
char Str;
int  I, Val, Val0, Sum;
[I:= 0;  Sum:= 0;  Val0:= 5000;
loop    [case Str(I) of
          ^M: Val:= 1000;
          ^D: Val:= 500;
          ^C: Val:= 100;
          ^L: Val:= 50;
          ^X: Val:= 10;
          ^V: Val:= 5;
          ^I: Val:= 1
        other return Sum;       \zero string terminator
        I:= I+1;
        Sum:= Sum + Val;
        if Val > Val0 then Sum:= Sum - 2*Val0;
        Val0:= Val;
        ];
];

[IntOut(0, Roman("MCMXC"));    CrLf(0);
 IntOut(0, Roman("MMVIII"));   CrLf(0);
 IntOut(0, Roman("MDCLXVI"));  CrLf(0);
]


xquery version "3.1";

declare function local:decode-roman-numeral($roman-numeral as xs:string) {
    $roman-numeral
    => upper-case()
    => for-each(
        function($roman-numeral-uppercase) {
            analyze-string($roman-numeral-uppercase, ".")/fn:match
            ! map { "M": 1000, "D": 500, "C": 100, "L": 50, "X": 10, "V": 5, "I": 1 }(.)
        }
    )
    => fold-right([0,0],
        function($number as xs:integer, $accumulator as array(*)) {
            let $running-total := $accumulator?1
            let $previous-number := $accumulator?2
            return
                if ($number lt $previous-number) then
                    [ $running-total - $number, $number ]
                else
                    [ $running-total + $number, $number ]
        }
    )
    => array:get(1)
};

let $roman-numerals :=
    map {
        "MCMXCIX": 1999,
        "MDCLXVI": 1666,
        "XXV": 25,
        "XIX": 19,
        "XI": 11,
        "CMLIV": 954,
        "MMXI": 2011,
        "CD": 400,
        "MCMXC": 1990,
        "MMVIII": 2008,
        "MMIX": 2009,
        "MMMDCCCLXXXVIII": 3888
    }
return
    map:for-each(
        $roman-numerals,
        function($roman-numeral, $expected-value) {
            local:decode-roman-numeral($roman-numeral) eq $expected-value
        }
    )


romans$ = "MDCLXVI"
decmls$ = "1000,500,100,50,10,5,1"

sub romanDec(s$)
    local i, n, prev, res, decmls$(1)

    n = token(decmls$, decmls$(), ",")

    for i = len(s$) to 1 step -1
        n = val(decmls$(instr(romans$, mid$(s$, i, 1))))
        if n < prev n = 0 - n
        res = res + n
        prev = n
    next i
    return res
end sub

? romanDec("MCMXCIX")               // 1999
? romanDec("MDCLXVI")               // 1666
? romanDec("XXV")                   // 25
? romanDec("XIX")                   // 19
? romanDec("XI")                    // 11
? romanDec("CMLIV")                 // 954
? romanDec("MMXI")                  // 2011
? romanDec("CD")                    // 400
? romanDec("MCMXC")                 // 1990
? romanDec("MMVIII")                // 2008
? romanDec("MMIX")                  // 2009
? romanDec("MDCLXVI")               // 1666
? romanDec("MMMDCCCLXXXVIII")       // 3888


var romans = L(
   L("M", 1000), L("CM", 900), L("D",  500), L("CD", 400), L("C",  100),
   L("XC",  90), L("L",   50), L("XL",  40), L("X",   10), L("IX",   9),
   L("V",    5), L("IV",   4), L("I",    1));
fcn toArabic(romanNumber){	// romanNumber needs to be upper case
   if (not RegExp("^[CDILMVX]+$").matches(romanNumber))
      throw(Exception.ValueError("Not a Roman number: %s".fmt(romanNumber)));
   reg value = 0;
   foreach R,N in (romans){
      while (0 == romanNumber.find(R)){
	 value += N;
	 romanNumber = romanNumber[R.len(),*];
      }
   }
   return(value);
}


program: roman_decimal
  input: 'XIII'
  output: 13


#!/bin/zsh
function parseroman () {
  local max=0 sum i j
  local -A conv
  conv=(I 1 V 5 X 10 L 50 C 100 D 500 M 1000)
  for j in ${(Oas::)1}; do
    i=conv[$j]
    if (( i >= max )); then
      (( sum+=i ))
      (( max=i ))
    else
      (( sum-=i ))
    fi
  done
  echo $sum
}

parseroman MCMXC
parseroman MMVIII
parseroman MDCLXVI


-V DIFF_THRESHOLD = 1e-40

T.enum Fixed
   FREE
   A
   B

T Node
   Float voltage
   Fixed fixed
   F (v = 0.0, f = Fixed.FREE)
      .voltage = v
      .fixed = f

F set_boundary(&m)
   m[1][1] = Node( 1.0, Fixed.A)
   m[6][7] = Node(-1.0, Fixed.B)

F calc_difference(m, &d)
   V h = m.len
   V w = m[0].len
   V total = 0.0

   L(i) 0 .< h
      L(j) 0 .< w
         V v = 0.0
         V n = 0
         I i != 0  {v += m[i - 1][j].voltage; n++}
         I j != 0  {v += m[i][j - 1].voltage; n++}
         I i < h-1 {v += m[i + 1][j].voltage; n++}
         I j < w-1 {v += m[i][j + 1].voltage; n++}
         v = m[i][j].voltage - v / n
         d[i][j].voltage = v
         I m[i][j].fixed == FREE
            total += v ^ 2
   R total

F iter(&m)
   V h = m.len
   V w = m[0].len
   V difference = [[Node()] * w] * h

   L
      set_boundary(&m)
      I calc_difference(m, &difference) < :DIFF_THRESHOLD
         L.break
      L(di) difference
         V i = L.index
         L(dij) di
            V j = L.index
            m[i][j].voltage -= dij.voltage

   V cur = [0.0] * 3
   L(di) difference
      V i = L.index
      L(dij) di
         V j = L.index
         cur[Int(m[i][j].fixed)] += (dij.voltage *
            (Int(i != 0) + Int(j != 0) + (i < h - 1) + (j < w - 1)))

   R (cur[Int(Fixed.A)] - cur[Int(Fixed.B)]) / 2.0

V w = 10
V h = 10
V mesh = [[Node()] * w] * h
print(‘R = #.16’.format(2 / iter(&mesh)))


with Ada.Text_IO; use Ada.Text_IO;
procedure ResistMesh is
   H, W : constant Positive := 10;
   rowA, colA : constant Positive := 2; -- row/col indexed from 1
   rowB : constant Positive := 7;
   colB : constant Positive := 8;

   type Ntype is (A, B, Free);
   type Vtype is digits 15;
   type Node is record
      volt : Vtype := 0.0;
      name : Ntype := Free;
   end record;
   type NodeMesh is array (Positive range <>, Positive range <>) of Node;
   package IIO is new Ada.Text_IO.Float_IO (Vtype);
   mesh, dmesh : NodeMesh (1 .. H, 1 .. W);
   curA, curB, diff : Vtype;

   procedure set_AB (mesh : in out NodeMesh) is begin
      mesh (rowA, colA).volt :=  1.0;  mesh (rowA, colA).name := A;
      mesh (rowB, colB).volt := -1.0;  mesh (rowB, colB).name := B;
   end set_AB;

   function sides (i : Positive; j : Positive) return Vtype is
      s : Integer := 0;
   begin
      if i /= 1 and i /= H then s := s + 2; else s := s + 1; end if;
      if j /= 1 and j /= W then s := s + 2; else s := s + 1; end if;
      return Vtype (s);
   end sides;

   procedure calc_diff (mesh : NodeMesh; dmesh : out NodeMesh;
      total : out Vtype)  is
      n : Natural;
      v : Vtype := 0.0;
   begin
      total := 0.0;
      for i in Positive range 1 .. H loop
         for j in Positive range 1 .. W loop
            n := 0;    v := 0.0;
            if  i /= 1 then v := v + mesh (i - 1, j).volt; n := n + 1; end if;
            if j /= 1 then  v := v + mesh (i, j - 1).volt; n := n + 1; end if;
            if i < H then v := v + mesh (i + 1, j).volt; n := n + 1; end if;
            if j < W then v := v + mesh (i, j + 1).volt; n := n + 1; end if;
            v := mesh (i, j).volt - v / Vtype (n);
            dmesh (i, j).volt := v;
            if mesh (i, j).name = Free then total := total + v ** 2; end if;
         end loop;
      end loop;
   end calc_diff;

begin

   loop
      set_AB (mesh);
      calc_diff (mesh, dmesh, diff);
      exit when diff < 1.0e-40;
      for i in Positive range 1 .. H loop
         for j in Positive range 1 .. W loop
            mesh (i, j).volt := mesh (i, j).volt - dmesh (i, j).volt;
         end loop;
      end loop;
   end loop;

   curA := dmesh (rowA, colA).volt * sides (rowA, colA);
   curB := dmesh (rowB, colB).volt * sides (rowB, colB);
   diff := 4.0 / (curA - curB);
   IIO.Put (diff, Exp => 0); New_Line;
end ResistMesh;


      INSTALL @lib$+"ARRAYLIB"
      *FLOAT 64
      @% = &F0F

      PRINT "Resistance = "; FNresistormesh(10, 10, 1, 1, 7, 6) " ohms"
      END

      DEF FNresistormesh(ni%, nj%, ai%, aj%, bi%, bj%)
      LOCAL c%, i%, j%, k%, n%, A(), B()
      n% = ni% * nj%
      DIM A(n%-1, n%-1), B(n%-1, 0)
      FOR i% = 0 TO ni%-1
        FOR j% = 0 TO nj%-1
          k% = i% * nj% + j%
          IF i% = ai% AND j% = aj% THEN
            A(k%, k%) = 1
          ELSE
            c% = 0
            IF (i% + 1) < ni% c% += 1 : A(k%, k% + nj%) = -1
            IF i% > 0         c% += 1 : A(k%, k% - nj%) = -1
            IF (j% + 1) < nj% c% += 1 : A(k%, k% + 1)   = -1
            IF j% > 0         c% += 1 : A(k%, k% - 1)   = -1
            A(k%, k%) = c%
          ENDIF
        NEXT
      NEXT
      k% = bi% * nj% + bj%
      B(k%, 0) = 1
      PROC_invert(A())
      B() = A().B()
      = B(k%, 0)


#include <stdio.h>
#include <stdlib.h>

#define S 10
typedef struct { double v; int fixed; } node;

#define each(i, x) for(i = 0; i < x; i++)
node **alloc2(int w, int h)
{
	int i;
	node **a = calloc(1, sizeof(node*)*h + sizeof(node)*w*h);
	each(i, h) a[i] = i ? a[i-1] + w : (node*)(a + h);
	return a;
}

void set_boundary(node **m)
{
	m[1][1].fixed =  1; m[1][1].v =  1;
	m[6][7].fixed = -1; m[6][7].v = -1;
}

double calc_diff(node **m, node **d, int w, int h)
{
	int i, j, n;
	double v, total = 0;
	each(i, h) each(j, w) {
		v = 0; n = 0;
		if (i) v += m[i-1][j].v, n++;
		if (j) v += m[i][j-1].v, n++;
		if (i+1 < h) v += m[i+1][j].v, n++;
		if (j+1 < w) v += m[i][j+1].v, n++;

		d[i][j].v = v = m[i][j].v - v / n;
		if (!m[i][j].fixed) total += v * v;
	}
	return total;
}

double iter(node **m, int w, int h)
{
	node **d = alloc2(w, h);
	int i, j;
	double diff = 1e10;
	double cur[] = {0, 0, 0};

	while (diff > 1e-24) {
		set_boundary(m);
		diff = calc_diff(m, d, w, h);
		each(i,h) each(j, w) m[i][j].v -= d[i][j].v;
	}

	each(i, h) each(j, w)
		cur[ m[i][j].fixed + 1 ] += d[i][j].v *
				(!!i + !!j + (i < h-1) + (j < w -1));

	free(d);
	return (cur[2] - cur[0])/2;
}

int main()
{
	node **mesh = alloc2(S, S);
	printf("R = %g\n", 2 / iter(mesh, S, S));
	return 0;
}


using System;
using System.Collections.Generic;

namespace ResistorMesh {
    class Node {
        public Node(double v, int fixed_) {
            V = v;
            Fixed = fixed_;
        }

        public double V { get; set; }
        public int Fixed { get; set; }
    }

    class Program {
        static void SetBoundary(List<List<Node>> m) {
            m[1][1].V = 1.0;
            m[1][1].Fixed = 1;

            m[6][7].V = -1.0;
            m[6][7].Fixed = -1;
        }

        static double CalcuateDifference(List<List<Node>> m, List<List<Node>> d, int w, int h) {
            double total = 0.0;
            for (int i = 0; i < h; i++) {
                for (int j = 0; j < w; j++) {
                    double v = 0.0;
                    int n = 0;
                    if (i > 0) {
                        v += m[i - 1][j].V;
                        n++;
                    }
                    if (j > 0) {
                        v += m[i][j - 1].V;
                        n++;
                    }
                    if (i + 1 < h) {
                        v += m[i + 1][j].V;
                        n++;
                    }
                    if (j + 1 < w) {
                        v += m[i][j + 1].V;
                        n++;
                    }
                    v = m[i][j].V - v / n;
                    d[i][j].V = v;
                    if (m[i][j].Fixed == 0) {
                        total += v * v;
                    }
                }
            }
            return total;
        }

        static double Iter(List<List<Node>> m, int w, int h) {
            List<List<Node>> d = new List<List<Node>>(h);
            for (int i = 0; i < h; i++) {
                List<Node> t = new List<Node>(w);
                for (int j = 0; j < w; j++) {
                    t.Add(new Node(0.0, 0));
                }
                d.Add(t);
            }

            double[] curr = new double[3];
            double diff = 1e10;

            while (diff > 1e-24) {
                SetBoundary(m);
                diff = CalcuateDifference(m, d, w, h);
                for (int i = 0; i < h; i++) {
                    for (int j = 0; j < w; j++) {
                        m[i][j].V -= d[i][j].V;
                    }
                }
            }

            for (int i = 0; i < h; i++) {
                for (int j = 0; j < w; j++) {
                    int k = 0;
                    if (i != 0) k++;
                    if (j != 0) k++;
                    if (i < h - 1) k++;
                    if (j < w - 1) k++;
                    curr[m[i][j].Fixed + 1] += d[i][j].V * k;
                }
            }

            return (curr[2] - curr[0]) / 2.0;
        }

        const int S = 10;
        static void Main(string[] args) {
            List<List<Node>> mesh = new List<List<Node>>(S);
            for (int i = 0; i < S; i++) {
                List<Node> t = new List<Node>(S);
                for (int j = 0; j < S; j++) {
                    t.Add(new Node(0.0, 0));
                }
                mesh.Add(t);
            }

            double r = 2.0 / Iter(mesh, S, S);
            Console.WriteLine("R = {0:F15}", r);
        }
    }
}


#include <iomanip>
#include <iostream>
#include <vector>

class Node {
private:
    double v;
    int fixed;

public:
    Node() : v(0.0), fixed(0) {
        // empty
    }

    Node(double v, int fixed) : v(v), fixed(fixed) {
        // empty
    }

    double getV() const {
        return v;
    }

    void setV(double nv) {
        v = nv;
    }

    int getFixed() const {
        return fixed;
    }

    void setFixed(int nf) {
        fixed = nf;
    }
};

void setBoundary(std::vector<std::vector<Node>>& m) {
    m[1][1].setV(1.0);
    m[1][1].setFixed(1);

    m[6][7].setV(-1.0);
    m[6][7].setFixed(-1);
}

double calculateDifference(const std::vector<std::vector<Node>>& m, std::vector<std::vector<Node>>& d, const int w, const int h) {
    double total = 0.0;
    for (int i = 0; i < h; ++i) {
        for (int j = 0; j < w; ++j) {
            double v = 0.0;
            int n = 0;
            if (i > 0) {
                v += m[i - 1][j].getV();
                n++;
            }
            if (j > 0) {
                v += m[i][j - 1].getV();
                n++;
            }
            if (i + 1 < h) {
                v += m[i + 1][j].getV();
                n++;
            }
            if (j + 1 < w) {
                v += m[i][j + 1].getV();
                n++;
            }
            v = m[i][j].getV() - v / n;
            d[i][j].setV(v);
            if (m[i][j].getFixed() == 0) {
                total += v * v;
            }
        }
    }
    return total;
}

double iter(std::vector<std::vector<Node>>& m, const int w, const int h) {
    using namespace std;
    vector<vector<Node>> d;
    for (int i = 0; i < h; ++i) {
        vector<Node> t(w);
        d.push_back(t);
    }

    double curr[] = { 0.0, 0.0, 0.0 };
    double diff = 1e10;

    while (diff > 1e-24) {
        setBoundary(m);
        diff = calculateDifference(m, d, w, h);
        for (int i = 0; i < h; ++i) {
            for (int j = 0; j < w; ++j) {
                m[i][j].setV(m[i][j].getV() - d[i][j].getV());
            }
        }
    }

    for (int i = 0; i < h; ++i) {
        for (int j = 0; j < w; ++j) {
            int k = 0;
            if (i != 0) ++k;
            if (j != 0) ++k;
            if (i < h - 1) ++k;
            if (j < w - 1) ++k;
            curr[m[i][j].getFixed() + 1] += d[i][j].getV()*k;
        }
    }

    return (curr[2] - curr[0]) / 2.0;
}

const int S = 10;
int main() {
    using namespace std;
    vector<vector<Node>> mesh;

    for (int i = 0; i < S; ++i) {
        vector<Node> t(S);
        mesh.push_back(t);
    }

    double r = 2.0 / iter(mesh, S, S);
    cout << "R = " << setprecision(15) << r << '\n';

    return 0;
}


import std.stdio, std.traits;

enum Node.FP differenceThreshold = 1e-40;

struct Node {
    alias FP = real;
    enum Kind : size_t { free, A, B }

    FP voltage = 0.0;

    /*const*/ private Kind kind = Kind.free;
    // Remove kindGet once kind is const.
    @property Kind kindGet() const pure nothrow @nogc {return kind; }
}

Node.FP iter(size_t w, size_t h)(ref Node[w][h] m) pure nothrow @nogc {
    static void enforceBoundaryConditions(ref Node[w][h] m)
    pure nothrow @nogc {
        m[1][1].voltage =  1.0;
        m[6][7].voltage = -1.0;
    }

    static Node.FP calcDifference(in ref Node[w][h] m,
                                  ref Node[w][h] d) pure nothrow @nogc {
        Node.FP total = 0.0;

        foreach (immutable i; 0 .. h) {
            foreach (immutable j; 0 .. w) {
                Node.FP v = 0.0;
                {
                    size_t n = 0;
                    if (i != 0)    { v += m[i - 1][j].voltage; n++; }
                    if (j != 0)    { v += m[i][j - 1].voltage; n++; }
                    if (i < h - 1) { v += m[i + 1][j].voltage; n++; }
                    if (j < w - 1) { v += m[i][j + 1].voltage; n++; }
                    v = m[i][j].voltage - v / n;
                }

                d[i][j].voltage = v;
                if (m[i][j].kindGet == Node.Kind.free)
                    total += v ^^ 2;
            }
        }

        return total;
    }

    Node[w][h] difference;

    while (true) {
        enforceBoundaryConditions(m);
        if (calcDifference(m, difference) < differenceThreshold)
            break;
        foreach (immutable i, const di; difference)
            foreach (immutable j, const ref dij; di)
                m[i][j].voltage -= dij.voltage;
    }

    Node.FP[EnumMembers!(Node.Kind).length] cur = 0.0;
    foreach (immutable i, const di; difference)
        foreach (immutable j, const ref dij; di)
            cur[m[i][j].kindGet] += dij.voltage *
                                   (!!i + !!j + (i < h-1) + (j < w-1));

    return (cur[Node.Kind.A] - cur[Node.Kind.B]) / 2.0;
}

void main() {
    enum size_t w = 10,
                h = w;
    Node[w][h] mesh;

    // Set A and B Nodes.
    mesh[1][1] = Node( 1.0, Node.Kind.A);
    mesh[6][7] = Node(-1.0, Node.Kind.B);

    writefln("R = %.19f", 2 / mesh.iter);
}


 PROGRAM RESISTENCE_MESH

 !$BASE=1

 !$DYNAMIC
 DIM A[0,0]

 BEGIN

  N=10
  NN=N*N
  !$DIM A[NN,NN+1]

  PRINT(CHR$(12);) !CLS
  ! generate matrix data
  NODE=0
  FOR ROW=1 TO N DO
    FOR COL=1 TO N DO
        NODE=NODE+1
        IF ROW>1 THEN
            A[NODE,NODE]=A[NODE,NODE]+1
            A[NODE,NODE-N]=-1
        END IF
        IF ROW<N THEN
            A[NODE,NODE]=A[NODE,NODE]+1
            A[NODE,NODE+N]=-1
        END IF
        IF COL>1 THEN
            A[NODE,NODE]=A[NODE,NODE]+1
            A[NODE,NODE-1]=-1
        END IF
        IF COL<N THEN
            A[NODE,NODE]=A[NODE,NODE]+1
            A[NODE,NODE+1]=-1
        END IF
    END FOR
  END FOR

  AR=2  AC=2  A=AC+N*(AR-1)
  BR=7  BC=8  B=BC+N*(BR-1)
  A[A,NN+1]=-1
  A[B,NN+1]=1

  PRINT("Nodes ";A,B)

  ! solve linear system
  ! using Gauss-Seidel method
  ! with pivoting
  R=NN

  FOR J=1 TO R DO
    FOR I=J TO R DO
      EXIT IF A[I,J]<>0
    END FOR
    IF I=R+1 THEN
      PRINT("No solution!")
      !$STOP
    END IF
    FOR K=1 TO R+1 DO
      SWAP(A[J,K],A[I,K])
    END FOR
    Y=1/A[J,J]
    FOR K=1 TO R+1 DO
      A[J,K]=Y*A[J,K]
    END FOR
    FOR I=1 TO R DO
      IF I<>J THEN
         Y=-A[I,J]
         FOR K=1 TO R+1 DO
            A[I,K]=A[I,K]+Y*A[J,K]
         END FOR
      END IF
    END FOR
  END FOR
  PRINT("Resistence=";ABS(A[A,NN+1]-A[B,NN+1]))
 END PROGRAM


>load incidence;
>{u,r}=solvePotentialX(makeRectangleX(10,10),12,68); r,
 1.60899124173


' version 01-07-2018
' compile with: fbc -s console

#Define n 10

Dim As UInteger nn = n * n
Dim As Double g(-nn To nn +1, -nn To nn +1)
Dim As UInteger node, row, col

For row = 1 To n
    For col = 1 To n
        node += 1
        If row > 1 Then
            g(node, node) += 1
            g(node, node - n) = -1
        End If
        If row < n Then
            g(node, node) += 1
            g(node, node + n) = -1
        End If
        If col > 1 Then
            g(node, node) += 1
            g(node, node -1) = -1
        End If
        If col < n Then
            g(node, node) += 1
            g(node, node +1) = -1
        End If
    Next
Next

Dim As UInteger ar = 2, ac = 2
Dim As UInteger br = 7, bc = 8
Dim As UInteger a = ac + n * (ar -1)
Dim As UInteger b = bc + n * (br -1)

g(a, nn +1) = -1
g(b, nn +1) = 1

Print : Print "Nodes a: "; a, " b: "; b

' solve linear system using Gauss-Seidel method with pivoting
Dim As UInteger i, j, k
Dim As Double y

Do
    For j = 1 To nn
        For i = j To nn
            If g(i, j) <> 0 Then Exit For
        Next
        If i = nn +1 Then
            Print : Print "No solution"
            Exit Do
        End If
        For k = 1 To nn +1
            Swap g(j, k), g(i, k)
        Next
        y = g(j, j)
        For k = 1 To nn +1
            g(j, k) = g(j, k) / y
        Next
        For i = 1 To nn
            If i <> j Then
                y = -g(i, j)
                For k = 1 To nn +1
                    g(i, k) = g(i, k) + y * g(j, k)
                Next
            End If
        Next
    Next

    Print
    Print "Resistance ="; Abs(g(a, nn +1) - g(b, nn +1)); " Ohm"
    Exit Do
Loop

' empty keyboard buffer
While Inkey <> "" : Wend
Print : Print "hit any key to end program"
Sleep
End


package main

import "fmt"

const (
	S = 10
)

type node struct {
	v     float64
	fixed int
}

func alloc2(w, h int) [][]node {
	a := make([][]node, h)

	for i := range a {
		a[i] = make([]node, w)
	}
	return a
}

func set_boundary(m [][]node) {
	m[1][1].fixed = 1
	m[1][1].v = 1
	m[6][7].fixed = -1
	m[6][7].v = -1
}

func calc_diff(m [][]node, d [][]node, w, h int) float64 {
	total := 0.0
	for i := 0; i < h; i++ {
		for j := 0; j < w; j++ {
			v := 0.0
			n := 0
			if i != 0 {
				v += m[i-1][j].v
				n++
			}
			if j != 0 {
				v += m[i][j-1].v
				n++
			}
			if i+1 < h {
				v += m[i+1][j].v
				n++
			}
			if j+1 < w {
				v += m[i][j+1].v
				n++
			}

			v = m[i][j].v - v/float64(n)
			d[i][j].v = v
			if m[i][j].fixed == 0 {
				total += v * v
			}
		}
	}
	return total
}

func iter(m [][]node, w, h int) float64 {
	d := alloc2(w, h)
	diff := 1.0e10
	cur := []float64{0, 0, 0}

	for diff > 1e-24 {
		set_boundary(m)
		diff = calc_diff(m, d, w, h)
		for i := 0; i < h; i++ {
			for j := 0; j < w; j++ {
				m[i][j].v -= d[i][j].v
			}
		}
	}

	for i := 0; i < h; i++ {
		for j := 0; j < w; j++ {
			t := 0
			if i != 0 {
				t += 1
			}
			if j != 0 {
				t += 1
			}
			if i < h-1 {
				t += 1
			}
			if j < w-1 {
				t += 1
			}
			cur[m[i][j].fixed+1] += d[i][j].v * float64(t)
		}
	}
	return (cur[2] - cur[0]) / 2
}

func main() {
	mesh := alloc2(S, S)
	fmt.Printf("R = %g\n", 2/iter(mesh, S, S))
}


{-# LANGUAGE ParallelListComp #-}
import Numeric.LinearAlgebra (linearSolve, toDense, (!), flatten)
import Data.Monoid ((<>), Sum(..))

rMesh n (ar, ac) (br, bc)
  | n < 2 = Nothing
  | any (\x -> x < 1 || x > n) [ar, ac, br, bc] = Nothing
  | otherwise = between a b <$> voltage
  where
    a = (ac - 1) + n*(ar - 1)
    b = (bc - 1) + n*(br - 1)

    between x y v = abs (v ! a - v ! b)

    voltage = flatten <$> linearSolve matrixG current

    matrixG = toDense $ concat [ element row col node
                               | row <- [1..n], col <- [1..n]
                               | node <- [0..] ]

    element row col node =
      let (Sum c, elements) =
            (Sum 1, [((node, node-n), -1)]) `when` (row > 1) <>
            (Sum 1, [((node, node+n), -1)]) `when` (row < n) <>
            (Sum 1, [((node, node-1), -1)]) `when` (col > 1) <>
            (Sum 1, [((node, node+1), -1)]) `when` (col < n)
      in [((node, node), c)] <> elements

    x `when` p = if p then x else mempty

    current  = toDense [ ((a, 0), -1) , ((b, 0),  1) , ((n^2-1, 0), 0) ]


nodes=: 10 10 #: i. 100
nodeA=: 1 1
nodeB=: 6 7

NB. verb to pair up coordinates along a specific offset
conn =: [: (#~ e.~/@|:~&0 2) ([ ,: +)"1

ref =: ~. nodeA,nodes-.nodeB                    NB. all nodes, with A first and B omitted
wiring=: /:~ ref i. ,/ nodes conn"2 1 (,-)=i.2  NB. connected pairs (indices into ref)
Yii=: (* [email protected]@#) #/.~ {."1 wiring               NB. diagonal of Y represents connections to B
Yij=: -1:`(<"1@[)`]}&(+/~ 0*i.1+#ref) wiring    NB. off diagonal of Y represents wiring
Y=: _1 _1 }. Yii+Yij