Data update
This commit is contained in:
Ingy döt Net
parent
8e4e15fa56
commit
72eb4943cb
1853 changed files with 35514 additions and 9441 deletions
|
|
@ -0,0 +1,63 @@
|
|||
BEGIN # Burrows-Wheeler transform - translated from the EasyLang sample #
|
||||
PR read "sort.incl.a68" PR # include sort utilities #
|
||||
CHAR stx = REPR 2, etx = REPR 3;
|
||||
OP BWT = ( STRING s )STRING:
|
||||
BEGIN
|
||||
[ LWB s : UPB s + 2 ]STRING tbl;
|
||||
STRING ss = stx + s + etx;
|
||||
FOR i FROM LWB ss TO UPB ss DO
|
||||
STRING a = ss[ LWB ss : i ];
|
||||
STRING b = IF i >= UPB ss THEN "" ELSE ss[ i + 1 : ] FI;
|
||||
tbl[ i ] := b + a
|
||||
OD;
|
||||
QUICKSORT tbl;
|
||||
STRING r := "";
|
||||
FOR s pos FROM LWB tbl TO UPB tbl DO
|
||||
r +:= tbl[ s pos ][ UPB tbl[ s pos ] ]
|
||||
OD;
|
||||
r
|
||||
END # BWT # ;
|
||||
OP IBWT = ( STRING r )STRING:
|
||||
BEGIN
|
||||
[ LWB r : UPB r ]STRING tbl;
|
||||
FOR j FROM LWB r TO UPB r DO tbl[ j ] := "" OD;
|
||||
FROM LWB r TO UPB r DO
|
||||
FOR k FROM LWB r TO UPB r DO
|
||||
r[ k ] +=: tbl[ k ]
|
||||
OD;
|
||||
QUICKSORT tbl
|
||||
OD;
|
||||
STRING result := "";
|
||||
FOR r pos FROM LWB tbl TO UPB tbl WHILE result = "" DO
|
||||
STRING row = tbl[ r pos ];
|
||||
IF row[ UPB row ] = etx THEN result := row[ LWB row + 1 : UPB row - 1 ] FI
|
||||
OD;
|
||||
result
|
||||
END # IBWT # ;
|
||||
|
||||
BEGIN
|
||||
OP XTX = ( STRING s )STRING: # make stx and etx visible #
|
||||
BEGIN
|
||||
STRING result := "";
|
||||
FOR s pos FROM LWB s TO UPB s DO
|
||||
CHAR c = s[ s pos ];
|
||||
result +:= IF c = stx THEN "<stx>"
|
||||
ELIF c = etx THEN "<etx>"
|
||||
ELSE c
|
||||
FI
|
||||
OD;
|
||||
result
|
||||
END # XTX # ;
|
||||
[]STRING tests = ( "banana", "appellee", "dogwood"
|
||||
, "TO BE OR NOT TO BE OR WANT TO BE OR NOT?"
|
||||
, "SIX.MIXED.PIXIES.SIFT.SIXTY.PIXIE.DUST.BOXES"
|
||||
);
|
||||
FOR t pos FROM LWB tests TO UPB tests DO
|
||||
STRING s = tests[ t pos ];
|
||||
print( ( s, newline ) );
|
||||
STRING h = BWT s;
|
||||
print( ( " -> ", XTX h, newline ) );
|
||||
print( ( IBWT h, newline, newline ) )
|
||||
OD
|
||||
END
|
||||
END
|
||||
|
|
@ -0,0 +1,163 @@
|
|||
program BurrowsWheeler
|
||||
implicit none
|
||||
|
||||
! Main program
|
||||
call Test("BANANA")
|
||||
call Test("CANAAN")
|
||||
call Test("CANCAN")
|
||||
call Test("appellee")
|
||||
call Test("dogwood")
|
||||
call Test("TO BE OR NOT TO BE OR WANT TO BE OR NOT?")
|
||||
call Test("SIX.MIXED.PIXIES.SIFT.SIXTY.PIXIE.DUST.BOXES")
|
||||
call Test("Four score and 7 years ago, our forefathers set forth on this continent to establish a new nation "//&
|
||||
"conceived in liberty and dedicated to he proposition that all men were created equal")
|
||||
contains
|
||||
! Function to compare rotations
|
||||
integer function CompareRotations(input, n, a, b)
|
||||
character(len=*), intent(in) :: input
|
||||
integer, intent(in) :: n, a, b
|
||||
integer :: p, q, nrNotTested
|
||||
integer :: i ,k
|
||||
|
||||
CompareRotations = 0
|
||||
p = a
|
||||
q = b
|
||||
nrNotTested = n
|
||||
do
|
||||
p = p + 1
|
||||
if (p == n) p = 0
|
||||
q = q + 1
|
||||
if (q == n) q = 0
|
||||
i = p + 1
|
||||
k = q + 1
|
||||
if (input(i:i) == input(k:k)) then
|
||||
nrNotTested = nrNotTested - 1
|
||||
else if (input(i:i) > input(k:k)) then
|
||||
CompareRotations = 1
|
||||
exit
|
||||
else
|
||||
CompareRotations = -1
|
||||
exit
|
||||
end if
|
||||
if (nrNotTested == 0) exit
|
||||
end do
|
||||
end function CompareRotations
|
||||
|
||||
! Subroutine to encode the input string
|
||||
subroutine Encode(input, encoded, index)
|
||||
character(len=*), intent(in) :: input
|
||||
character(len=*), intent(out) :: encoded
|
||||
integer, intent(out) :: index
|
||||
integer :: n, i, j, k, incr, v
|
||||
integer, allocatable :: perm(:)
|
||||
|
||||
n = len(input)
|
||||
allocate(perm(0:n-1))
|
||||
do j = 0, n - 1
|
||||
perm(j) = j
|
||||
end do
|
||||
|
||||
! Shell sort
|
||||
incr = 1
|
||||
do
|
||||
incr = 3 * incr + 1
|
||||
if (incr >= n) exit
|
||||
end do
|
||||
do
|
||||
incr = incr / 3
|
||||
do i = incr, n - 1
|
||||
v = perm(i)
|
||||
j = i
|
||||
do while (j >= incr)
|
||||
if(CompareRotations(input, n, perm(j - incr), v) /= 1)exit
|
||||
perm(j) = perm(j - incr)
|
||||
j = j - incr
|
||||
end do
|
||||
perm(j) = v
|
||||
end do
|
||||
if (incr == 1) exit
|
||||
end do
|
||||
|
||||
! Create the output
|
||||
do j = 0, n - 1
|
||||
k = perm(j)
|
||||
encoded(j + 1:j + 1) = input(k + 1:k + 1)
|
||||
if (k == n - 1) index = j
|
||||
end do
|
||||
|
||||
deallocate(perm)
|
||||
end subroutine Encode
|
||||
|
||||
! Function to decode the encoded string
|
||||
function Decode(encoded, index) result(decoded)
|
||||
character(len=*), intent(in) :: encoded
|
||||
integer, intent(in) :: index
|
||||
character(len=:), allocatable :: decoded
|
||||
integer :: charInfo(0:255)
|
||||
integer, allocatable :: perm(:)
|
||||
integer :: n, j, k, total, prev
|
||||
character :: c
|
||||
|
||||
n = len(encoded)
|
||||
if (n == 0) then
|
||||
decoded = ""
|
||||
return
|
||||
end if
|
||||
|
||||
charInfo = 0
|
||||
do j = 0, n - 1
|
||||
c = encoded(j + 1:j + 1)
|
||||
charInfo(ichar(c)) = charInfo(ichar(c)) + 1
|
||||
end do
|
||||
|
||||
total = 0
|
||||
prev = 0
|
||||
do k = 0, 255
|
||||
total = total + prev
|
||||
prev = charInfo(k)
|
||||
charInfo(k) = total
|
||||
end do
|
||||
|
||||
allocate(perm(0:n-1))
|
||||
do j = 0, n - 1
|
||||
c = encoded(j + 1:j + 1)
|
||||
k = charInfo(ichar(c))
|
||||
perm(k) = j
|
||||
charInfo(ichar(c)) = charInfo(ichar(c)) + 1
|
||||
end do
|
||||
|
||||
allocate(character(len=n) :: decoded)
|
||||
k = 0
|
||||
j = index
|
||||
do
|
||||
j = perm(j)
|
||||
decoded(k + 1:k + 1) = encoded(j + 1:j + 1)
|
||||
k = k + 1
|
||||
if (j == index) exit
|
||||
end do
|
||||
|
||||
if (k < n) then
|
||||
do j = k, n - 1
|
||||
decoded(j + 1:j + 1) = decoded(j - k + 1:j - k + 1)
|
||||
end do
|
||||
end if
|
||||
end function Decode
|
||||
|
||||
! Subroutine to test the encoding and decoding
|
||||
subroutine Test(s)
|
||||
character(len=*), intent(in) :: s
|
||||
character(len=:), allocatable :: encoded, decoded
|
||||
integer :: index
|
||||
|
||||
print *, ""
|
||||
print *, " ", s
|
||||
allocate(character(len=len(s)) :: encoded)
|
||||
call Encode(s, encoded, index)
|
||||
print *, "---> ", encoded
|
||||
print *, " index = ", index
|
||||
decoded = Decode(encoded, index)
|
||||
print *, "---> ", decoded
|
||||
deallocate(encoded)
|
||||
end subroutine Test
|
||||
|
||||
end program BurrowsWheeler
|
||||
Loading…
Add table
Add a link
Reference in a new issue