tasks a-s

Task/Run-length-encoding/Fortran/run-length-encoding.f

@@ -0,0 +1,73 @@
+program RLE
+  implicit none
+
+  integer, parameter :: bufsize = 100   ! Sets maximum size of coded and decoded strings, adjust as necessary
+  character(bufsize) :: teststr = "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"	
+  character(bufsize) :: codedstr = "" Encode (Data (Index..Data'Last));
+            end;
+         end;
+      end if;
+   end Encode;
+   function Decode (Data : String) return String is
+   begin
+      if Data'Length = 0 then
+         return "";
+      else
+         declare
+            Index : Integer := Data'First;
+            Count : Natural := 0;
+         begin
+            while Index , decodedstr = ""
+
+  call Encode(teststr, codedstr)
+  write(*,"(a)") trim(codedstr)
+  call Decode(codedstr, decodedstr)
+  write(*,"(a)") trim(decodedstr)
+
+contains
+
+subroutine Encode(instr, outstr)
+  character(*), intent(in)  :: instr
+  character(*), intent(out) :: outstr
+  character(8) :: tempstr = ""
+  character(26) :: validchars = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
+  integer :: a, b, c, i
+
+  if(verify(trim(instr), validchars) /= 0) then
+    outstr = "Invalid input"
+    return
+  end if
+  outstr = ""
+  c = 1
+  a = iachar(instr(1:1))
+  do i = 2, len(trim(instr))
+    b = iachar(instr(i:i))
+    if(a == b) then
+      c = c + 1
+    else
+      write(tempstr, "(i0)") c
+      outstr = trim(outstr) // trim(tempstr) // achar(a)
+      a = b
+      c = 1
+    end if
+  end do
+  write(tempstr, "(i0)") c
+  outstr = trim(outstr) // trim(tempstr) // achar(b)
+end subroutine
+
+subroutine Decode(instr, outstr)
+  character(*), intent(in)  :: instr
+  character(*), intent(out) :: outstr
+  character(26) :: validchars = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
+  integer :: startn, endn, n
+
+  outstr = ""
+  startn = 1
+  do while(startn < len(trim(instr)))
+    endn = scan(instr(startn:), validchars) + startn - 1
+    read(instr(startn:endn-1), "(i8)") n
+    outstr = trim(outstr) // repeat(instr(endn:endn), n)
+    startn = endn + 1
+  end do
+end subroutine
+end program