Groups | Search | Server Info | Keyboard shortcuts | Login | Register [http] [https] [nntp] [nntps]

Groups > comp.lang.forth > #54037

.Re: Bioinformatics (at least string comparison) in Forth

Show all headers | View raw

lehs wrote:

> > Being a bioinformatician by
> > education, I've started thinking
> > about implementing various
> > important bioinformatics
> > algorithms in Forth. Has anyone
> > implemented various string
> > comparison algorithms in Forth?
> > How about graph theory or network
> > analysis algorithms?
> > 
> > Here are some words to get us
> > started. These are for finding
> > the Hamming distance between two
> > strings of equal length:
> > 
> > : SUM ( n1 n2 ... nn -- n ) DEPTH 1 DO + LOOP ; 
> > (get sum of all elements on stack)


This is absolutely nonsensical.

There may be numbers on the stack under the numbers that
actually should be summed.


> > 
> > : COMPLETTER ( adr1 adr2 -- flag ) DUP C@ ROT DUP C@ ROT XOR 0 > NEGATE ROT ROT ;
> > (compare letter at address 1 to letter at address 2 - result
> > is 0 if same letter, 1 if different)
> > 
> > : ADVLETTER ( adr1 adr2 -- adr3 adr4 ) CHAR+ SWAP CHAR+ SWAP ;
> > (move up one letter in each string)
> > 
> > : HAMMING DROP SWAP 1+ 1 DO COMPLETTER ADVLETTER LOOP 2DROP SUM ; 
> > (full Hamming distance subroutine)
> > 
> > Example: S" TEST" S" REST" HAMMING . (result is 1)
> > 
> > Looking forward to reading more words! :)
> > 
> > Jon
> 
> \ String stack
> 
> : clearbuf \ ad --
>   dup cell+ swap ! ;
> 
> variable stp
> 
> 0x4000 constant stlim
> stlim allocate throw dup constant stbuf clearbuf
> \ ascii buffer, at stbuf is loaded address to first free byte
> 
> 0x1000 constant stalim
> stalim allocate throw dup constant staddr clearbuf
> \ address buffer, at staddr is loaded address to first free cell
> 
> : >st \ ad n -- 
>   tuck             \ n ad n
>   stbuf @ dup      \ n ad n a a
>   staddr @ !       \ n ad n a
>   cell staddr +!
>   swap move        \ n
>   stbuf +! 
>   1 stp +! ;
> 
> : st@ \ -- ad n
>   stp @ cells staddr + @ 
>   dup stbuf @ swap - ;
> 
> : st> \ -- ad n
>   st@ over stbuf !
>   cell negate staddr +!
>   -1 stp +! ;
> 
> : sempty \ -- flag
>   stp @ 0= ;
> 
> : ist@ \ i -- ad n     i=1,...
>   dup stp @ = 
>   if cells staddr + @ dup stbuf
>   else cells staddr + dup @ dup rot cell+ 
>   then @ swap - ;
>   
> : spickad \ k -- ad n
>   stp @ swap - ist@ ;
> 
> : .st stp @ 1+ 1 ?do cr i ist@ type loop ;
> 
> : s [char] " parse >st ;
> 
> : sdup stp @ ist@ >st ;
> : sdrop st> 2drop ;
> : sover stp @ 1- ist@ >st ;
> : snip st> sdrop >st ;
> : sswap sover st> st> sdrop >st >st ;
> : soover stp @ 2 - ist@ >st ;
> : srot soover st> st> st> sdrop >st >st >st ;
> : stuck sswap sover ;
> : spick spickad >st ;
> 
> : s& \ s1 s2 -- s1&s2
>   -1 stp +! 
>   staddr @ @
>   cell negate staddr +!
>   staddr @ ! ;
> 
> : sincl \ s1 s2 -- | -- n flag
>   st> st> search rot drop ;
> 
> : scomp \ s1 s2 -- | -- n
>   st> st> 2swap compare ;
> 
> : sleft \ s -- s' | n --   the n leftmost chars
>   st> drop swap >st ;
> 
> : sright \ s -- s' | n --  the n rightmost chars
>   st> rot over swap - /string >st ;
> 
> : sduplen \ s -- s | -- n
>   st@ nip ;
> 
> : slen= \ s1 s2 -- | -- flag
>   st> nip st> nip = ;
> 
> : schr& \ s -- s' | ch --
>   >r st> 2dup + r> swap c! 1+ >st ;
> 
> : sbl& bl schr& ;
> : s,& [char] , schr& ;
> : s.& [char] . schr& ;
> : s;& [char] ; schr& ;
> : s:& [char] : schr& ;
> : s?& [char] ? schr& ;
> : s!& [char] ! schr& ;
> : s-& [char] - schr& ;
> 
> : hamming \ s1 s2 -- s1 s2 | -- n
>   0 1 spickad drop st@ 0
>   do over i + c@ 
>      over i + c@ = 0=
>      if rot 1+ -rot then
>   loop 2drop ;

Ruby:

def hamming(a,b)
  a.each_char.zip(b.each_char).count{|x,y| x!=y}
end

hamming "karolin", "kathrin"
    ==>3

hamming "karolin", "kerstin"
    ==>3

hamming "1011101", "1001001"
    ==>2

hamming "2173896", "2233796"
    ==>3

hamming "climb", "climb"
    ==>0

-- 
"Palestine is not the ultimate goal of the Jews; the world is. Palestine is
just the place for the world state headquarters."  Israel Shamir in Cabbala of
Power   (www.theoccidentalobserver.net/authors/Connelly-Gaza2.html)

Back to comp.lang.forth | Previous | Next | Find similar | Unroll thread

Thread

.Re: Bioinformatics (at least string comparison) in Forth "Robert L." <No_spamming@noWhere_7073.org> - 2017-01-15 21:54 +0000

csiph-web