Groups > comp.lang.forth > #49393 > unrolled thread

Implementing binary search without going deeper than top 2 items on stack?

Started by	Alex Dowad <alexinbeijing@gmail.com>
First post	2016-07-24 10:41 -0700
Last post	2016-07-31 00:31 -0700
Articles	20 on this page of 31 — 12 participants

Back to article view | Back to comp.lang.forth

Page 1 of 2 [1] 2 Next page →

#49393 — Implementing binary search without going deeper than top 2 items on stack?

From	Alex Dowad <alexinbeijing@gmail.com>
Date	2016-07-24 10:41 -0700
Subject	Implementing binary search without going deeper than top 2 items on stack?
Message-ID	<5db2ff24-c31d-45a0-a4f9-6b0515203925@googlegroups.com>

Dear comp.lang.forth,

In his "1x Forth" talk (and other talks), Chuck Moore advocates for coding style whereby:

1. All definitions are at most 2 lines, and
2. Words do not directly access anything deeper than the top 2 items on the stack

In line with #2, Moore's colorForth has DUP, DROP, and OVER built in, but not PICK, ROLL, and so on.

I'd like to see examples of how this can be practical. For example, how would you implement a binary search without violating these rules?

("Directly accessing deeper items on the stack" would include using >R to get the top item(s) out of the way, then working with the deeper items.)

Or is the answer "if you're using binary search, you're doing it wrong. Don't use binary search"?

Thanks all,
Alex Dowad

[toc] | [next] | [standalone]

#49395

From	Paul Rubin <no.email@nospam.invalid>
Date	2016-07-24 11:18 -0700
Message-ID	<87d1m2c31r.fsf@jester.gateway.pace.com>
In reply to	#49393

Alex Dowad <alexinbeijing@gmail.com> writes:
> I'd like to see examples of how this can be practical. For example,
> how would you implement a binary search without violating these rules?

Basically, use global variables as temporaries.

[toc] | [prev] | [next] | [standalone]

#49400

From	Brad Eckert <hwfwguy@gmail.com>
Date	2016-07-24 13:23 -0700
Message-ID	<0f90531b-2852-477b-9ae6-0f6617ce6366@googlegroups.com>
In reply to	#49393

On Sunday, July 24, 2016 at 10:41:40 AM UTC-7, Alex Dowad wrote:
> I'd like to see examples of how this can be practical. For example,
> how would you implement a binary search without violating these rules?
> 
https://rosettacode.org/wiki/Sorting_algorithms/Quicksort#Forth

[toc] | [prev] | [next] | [standalone]

#49445

From	Alex Dowad <alexinbeijing@gmail.com>
Date	2016-07-24 23:10 -0700
Message-ID	<7fad0dc9-9653-4842-9d15-cf9bcc7e5eb9@googlegroups.com>
In reply to	#49400

On Sunday, 24 July 2016 22:23:24 UTC+2, Brad Eckert  wrote:
> On Sunday, July 24, 2016 at 10:41:40 AM UTC-7, Alex Dowad wrote:
> > I'd like to see examples of how this can be practical. For example,
> > how would you implement a binary search without violating these rules?
> > 
> https://rosettacode.org/wiki/Sorting_algorithms/Quicksort#Forth

Dear Brad,

Thanks for the reference! With some ideas from that Qsort, I came up with this:

    : mid ( l r -- mid ) + 2/ ;
    : bisect ( l r val -- l' r' )
      >r 2dup mid
      dup @ r> < if
        cell + rot drop swap \ ( mid+1 r )
      else
        nip \ ( l mid )
      then
    ;
    : bsearch ( l r val -- addr/false)
      >r
      begin 2dup <> while r@ bisect repeat
      @ r> = unless drop false then
    ;

That still isn't "2 lines or less per definition"... any ideas on how to factor it into smaller defs?

Thanks, Alex

[toc] | [prev] | [next] | [standalone]

#49446

From	humptydumpty <ouatubi@gmail.com>
Date	2016-07-24 23:28 -0700
Message-ID	<d22c015b-ecc0-4f69-b6a3-1f698a233fcd@googlegroups.com>
In reply to	#49445

On Monday, July 25, 2016 at 9:10:39 AM UTC+3, Alex Dowad wrote:
> On Sunday, 24 July 2016 22:23:24 UTC+2, Brad Eckert  wrote:
> > On Sunday, July 24, 2016 at 10:41:40 AM UTC-7, Alex Dowad wrote:
> > > I'd like to see examples of how this can be practical. For example,
> > > how would you implement a binary search without violating these rules?
> > > 
> > https://rosettacode.org/wiki/Sorting_algorithms/Quicksort#Forth
> 
> Dear Brad,
> 
> Thanks for the reference! With some ideas from that Qsort, I came up with this:
> 
>     : mid ( l r -- mid ) + 2/ ;
>     : bisect ( l r val -- l' r' )
>       >r 2dup mid
>       dup @ r> < if
>         cell + rot drop swap \ ( mid+1 r )
>       else
>         nip \ ( l mid )
>       then
>     ;
>     : bsearch ( l r val -- addr/false)
>       >r
>       begin 2dup <> while r@ bisect repeat
>       @ r> = unless drop false then
>     ;
> 
> That still isn't "2 lines or less per definition"... any ideas on how to factor it into smaller defs?
> 
> Thanks, Alex

Hi!

>     : mid ( l r -- mid ) + 2/ ;

OBS.: 'l' 'r' are addresses! 'mid' could return at half a cell!
Maybe let 'l' 'r' be indexes.

Have a nice day,
humptydumpty

[toc] | [prev] | [next] | [standalone]

#49448

From	Julian Fondren <ayrnieu@gmail.com>
Date	2016-07-25 00:08 -0700
Message-ID	<2ca46317-a58c-4c68-8784-8f0e7f84c39d@googlegroups.com>
In reply to	#49445

On Monday, July 25, 2016 at 1:10:39 AM UTC-5, Alex Dowad wrote:
> On Sunday, 24 July 2016 22:23:24 UTC+2, Brad Eckert  wrote:
> > On Sunday, July 24, 2016 at 10:41:40 AM UTC-7, Alex Dowad wrote:
> > > I'd like to see examples of how this can be practical. For example,
> > > how would you implement a binary search without violating these rules?
> > > 
> > https://rosettacode.org/wiki/Sorting_algorithms/Quicksort#Forth
> 
> Dear Brad,
> 
> Thanks for the reference! With some ideas from that Qsort, I came up with this:
> 
>     : mid ( l r -- mid ) + 2/ ;
>     : bisect ( l r val -- l' r' )
>       >r 2dup mid
>       dup @ r> < if
>         cell + rot drop swap \ ( mid+1 r )
>       else
>         nip \ ( l mid )
>       then
>     ;
>     : bsearch ( l r val -- addr/false)
>       >r
>       begin 2dup <> while r@ bisect repeat
>       @ r> = unless drop false then
>     ;
> 
> That still isn't "2 lines or less per definition"... any ideas on how to factor it into smaller defs?
> 
> Thanks, Alex

With bad names:

: third ( a b c -- a b c a )       dup 2over drop nip ;
: mid ( l r -- mid )               + 2/ ;
: bisect0 ( l r val -- l r mid f ) >r 2dup mid dup @ r> < ;
: bisect1 ( l r mid -- mid+1 r )   cell+ rot drop swap ;
: bisect  ( l r val -- l' r' )     bisect0 if bisect1 else nip then ;
: bsearch0 ( val l r -- val a a )  begin 2dup <> while third bisect repeat ; 
: bsearch1 ( l' x val -- a | 0 )   = unless drop false then ;
: bsearch ( l r val -- a | 0 )     -rot bsearch0 @ rot bsearch1 ;

Alternatively, only reformatting your own code:

: mid ( l r -- mid ) + 2/ ;
: bisect ( l r val -- l' r' )
  >r 2dup mid dup @ r> < if cell + rot drop swap ( mid+1 r )
  else nip ( l mid ) then ;
: bsearch ( l r val -- addr/false)
  >r begin 2dup <> while r@ bisect repeat
  @ r> = unless drop false then ;

None of this looks much like telegraphic 'washing machine' code.
Maybe better names can help the former code look that way.  Maybe
binary search is too nitty gritty of an operation to be telegraphic.

OTOH, this reads well:

: bsearch ( l r val -- a | 0 )
  -rot begin different? while bisect repeat found? ;

Given:

: found? ( val a1 a2 -- a1 | 0 )  @ rot <> if drop false then ;
: different? ( val l r -- val l r f )  2dup <> ;
: bisect ( val l r -- val l' r' )  third bisect ;

But "reads well" is not exactly what you're going for.

If you treat programming as a process, you can keep ideals in mind
and yet not always produce code that meets them.  You wouldn't want
to 'optimize for terseness' and start pulling out factors when
you're still not happy with what your code will actually be doing.
You may just consign yourself to completely throwing away factors
later on, when they're no longer useful.

Without saying "definition length doesn't matter" I would say that
you should be careful about comparing rough work with extremely
polished work, and that you should also not polish before your code
is somewhat settled.  At the same time, without a goal in mind, and
without some good biases, you may produce something that can't
simply be 'polished down'.

Take this dogma, but hold it lightly.


...  meanwhile, in VFX:

: third dup 2over drop nip ;  ok
see third 
( 000B:4A90 04A02CE5 . ,e )  str r10, [ r12, # $-04 ] !
( 000B:4A94 08A09CE5 . .e )  ldr r10, [ r12, # $08 ]
( 000B:4A98 0EF0A0E1 .p a )  mov PC, LR
12 bytes, 3 instructions.
 ok
: third2 2 pick ;  ok
see third2 
( 000B:4AC0 04A02CE5 . ,e )  str r10, [ r12, # $-04 ] !
( 000B:4AC4 08A09CE5 . .e )  ldr r10, [ r12, # $08 ]
( 000B:4AC8 0EF0A0E1 .p a )  mov PC, LR
12 bytes, 3 instructions.
 ok
: third3 >r over r> swap ;  ok
see third3 
( 000B:4AF0 04E02DE5 .`-e )  str LR, [ SP, # $-04 ] !
( 000B:4AF4 04A02DE5 . -e )  str r10, [ SP, # $-04 ] !
( 000B:4AF8 04A09DE4 . .d )  ldr r10, [ SP ], # $04
( 000B:4AFC 04A02CE5 . ,e )  str r10, [ r12, # $-04 ] !
( 000B:4B00 08A09CE5 . .e )  ldr r10, [ r12, # $08 ]
( 000B:4B04 04F09DE4 .p.d )  ldr PC, [ SP ], # $04
24 bytes, 6 instructions.
 ok


-- Julian

[toc] | [prev] | [next] | [standalone]

#49449

From	Alex Dowad <alexinbeijing@gmail.com>
Date	2016-07-25 00:29 -0700
Message-ID	<85b1b78e-8c76-4c97-a325-c3d0fbec917f@googlegroups.com>
In reply to	#49448

On Monday, 25 July 2016 09:08:28 UTC+2, Julian Fondren  wrote:
> OTOH, this reads well:
> 
> : bsearch ( l r val -- a | 0 )
>   -rot begin different? while bisect repeat found? ;
> 
> Given:
> 
> : found? ( val a1 a2 -- a1 | 0 )  @ rot <> if drop false then ;
> : different? ( val l r -- val l r f )  2dup <> ;
> : bisect ( val l r -- val l' r' )  third bisect ;
> 
> But "reads well" is not exactly what you're going for.

No, reads well *is* exactly what I'm going for.

The recommendations from "1x Forth" which I referred to in the OP -- using 1 or 2 line defs, not reaching deep down the stack -- were obviously not intended as some kind of brain puzzle. They were intended to help people write better code... that is, code which "reads well".

I felt that that those guidelines sound good, but it was very hard to see how they could possibly be practical. Using only the top 2 items on the stack? What if you have an algorithm which, by its nature, operates on 3 or more datums? The trick here was that you can also use the top of the retstack; and after looking at a very small amount of Moore's code, I can see that he also does the same.

Samuel Falvo's VIBE is a great example of a Forth program which uses only 1-line defs, and reads extremely well. But I felt that perhaps he was able to avoid reaching deep down the stack, simply because the "subject matter" didn't call for it.

Your code is awesome, and has helped make things a bit clearer again.

AD

[toc] | [prev] | [next] | [standalone]

#49453

From	Paul Rubin <no.email@nospam.invalid>
Date	2016-07-25 01:00 -0700
Message-ID	<87bn1m9mfk.fsf@jester.gateway.pace.com>
In reply to	#49449

Alex Dowad <alexinbeijing@gmail.com> writes:
> Using only the top 2 items on the stack? What if you have an
> algorithm which, by its nature, operates on 3 or more datums? The
> trick here was that you can also use the top of the retstack

Well there's a difference between having more than 2 items on the stack
during the algorithm, and having to juggle the stack around to reach
them.  E.g. I'd expect quicksort to look something like

 : qsort ( begin end -- ) partition ( begin pivot pivot end )
   recurse ( begin pivot ) recurse ;

partition would be factored into a forward-scanning word and a
backward-scanning one, etc.

[toc] | [prev] | [next] | [standalone]

#49484

From	Brad Eckert <hwfwguy@gmail.com>
Date	2016-07-25 09:36 -0700
Message-ID	<236786a3-c20a-40b9-aebb-dc5f83022578@googlegroups.com>
In reply to	#49445

On Sunday, July 24, 2016 at 11:10:39 PM UTC-7, Alex Dowad wrote:
>     : mid ( l r -- mid ) + 2/ ;
>     : bisect ( l r val -- l' r' )
>       >r 2dup mid
>       dup @ r> < if
>         cell + rot drop swap \ ( mid+1 r )
>       else
>         nip \ ( l mid )
>       then
>     ;
>     : bsearch ( l r val -- addr/false)
>       >r
>       begin 2dup <> while r@ bisect repeat
>       @ r> = unless drop false then
>     ;
> 
If you don't count control structure words, it's less than 15 words per definition. There's a loose rule of thumb that Forth definitions should be between 3 and 15 words (optimally 7) long, but it shouldn't overrule common sense. Short definitions have the benefit of testability and simplicity. Some words just want to be on the long side, but could be a hint that it's time to refactor.

Testability is important in Forth. Consider that it's possible to build an automobile that's controlled by one big MCU rather than dozens are smaller ones. Sure you can build it, but how would you test it? Small and simple makes for high integrity systems.

[toc] | [prev] | [next] | [standalone]

#49492

From	hughaguilar96@gmail.com
Date	2016-07-25 10:11 -0700
Message-ID	<0a82048b-5658-4d59-ab42-c8b49db22e81@googlegroups.com>
In reply to	#49445

On Sunday, July 24, 2016 at 11:10:39 PM UTC-7, Alex Dowad wrote:
> That still isn't "2 lines or less per definition"... any ideas on how to factor it into smaller defs?

A technique that I use, is to first develop some code factoring it into several functions and using global variables to hold data that is local to the group of functions. After I have the code developed, I change the sub-functions into macros (using my MACRO: in the novice package) and change the global variables into local variables all in the upper-level function that calls the other. Now I have one gigantic function (which is efficient), but it works perfectly the first time that I test it, because it started out life as a group of small well-factored functions.

I don't have a binary-search in the novice-package, although maybe I should. Here is the HeapSort function from the novice-package (this is actually more complicated than a binary-search function):

\ All of these macros use the locals from SORT, and can only be called from SORT.

macro: adr ( index -- adr )
    recsiz *  array + ;

macro: left ( x -- y )      2*  1+ ;

macro: right ( x -- y )     2*  2 + ;

macro: heapify ( x -- )
    dup >r  begin   \ r: -- great
        dup left    dup limit < if      dup adr  rover adr  'comparer execute if    rdrop  dup >r   then then  drop
        dup right   dup limit < if      dup adr  r@ adr     'comparer execute if    rdrop  dup >r   then then  drop
        dup r@ <> while
            adr  r@ adr  recsiz exchange
            r@ repeat
    drop rdrop ;

macro: build-max-heap ( -- )
    limit 1- 2/  begin  dup 0>= while  dup heapify  1- repeat drop ;

: sort { array limit recsiz 'comparer -- }
    recsiz  [ w 1- ] literal  and  abort" *** SORT: record size must be a multiple of the cell size ***"
    build-max-heap
    begin  limit while  -1 +to limit
        0 adr  limit adr  recsiz exchange
        0 heapify  repeat ;

\ The SORT locals:
\ array             \ the address of the 0th element
\ limit             \ the number of records in the array
\ recsiz            \ the size of a record in the array     \ this must be a multiple of W (FIELD assures this)
\ 'comparer         \ adrX adrY -- X>Y?

\ Note for the novice:
\ This code was originally written with colon words rather than macros, and using items rather than local variables.
\ After it was debugged, it was changed to use macros and locals so that it would be fast and reentrant.
\ One of the reasons why the heap-sort was chosen is because it is not recursive, which allows macros to be used.
\ Using macros allows the data (array, limit, recsiz, 'comparer) to be held in locals rather than items, which is reentrant.
\ See the file SORT.4TH for an early version.

[toc] | [prev] | [next] | [standalone]

#49455

From	Alex Dowad <alexinbeijing@gmail.com>
Date	2016-07-25 01:10 -0700
Message-ID	<1a44b537-9878-43e0-95d4-3e41dbdd8614@googlegroups.com>
In reply to	#49393

Here is another crack at it:

    : align<  [ cell 1- invert literal ] and ; \ align downwards to a cell boundary

    : reach ( a b c -- a b c a ) 2 pick ;
    : mid   ( l r -- mid ) + 2/ align< ;
    : pivot ( l r -- l r mid val ) 2dup mid dup @ ;

    : right-side ( l r mid -- mid+1 r ) rot drop cell + swap ;
    : left-side  ( l r mid -- l mid ) nip ;
    : bisect     ( l r val -- l' r' ) >r pivot r> < if right-side else left-side then ;
    : different? ( a b -- a b f ) 2dup <> ;
    : found?     ( val a a -- a|0 ) @ rot <> if drop false then ;
    : bsearch    ( val l r -- addr|0 ) begin different? while reach bisect repeat found? ;

[toc] | [prev] | [next] | [standalone]

#49457

From	humptydumpty <ouatubi@gmail.com>
Date	2016-07-25 01:32 -0700
Message-ID	<b41662eb-e500-4caf-8def-d63f33e17dc8@googlegroups.com>
In reply to	#49455

On Monday, July 25, 2016 at 11:10:21 AM UTC+3, Alex Dowad wrote:
> Here is another crack at it:
> 
>     : align<  [ cell 1- invert literal ] and ; \ align downwards to a cell boundary
> 
>     : reach ( a b c -- a b c a ) 2 pick ;
>     : mid   ( l r -- mid ) + 2/ align< ;
>     : pivot ( l r -- l r mid val ) 2dup mid dup @ ;
> 
>     : right-side ( l r mid -- mid+1 r ) rot drop cell + swap ;
>     : left-side  ( l r mid -- l mid ) nip ;
>     : bisect     ( l r val -- l' r' ) >r pivot r> < if right-side else left-side then ;
>     : different? ( a b -- a b f ) 2dup <> ;
>     : found?     ( val a a -- a|0 ) @ rot <> if drop false then ;
>     : bsearch    ( val l r -- addr|0 ) begin different? while reach bisect repeat found? ;

Hi!

: align<		( u -- u' )
  [ cell 1- invert ] literal and
;
: mid  		( al ar -- am ; avoid sum overflow)
  over - 2/ align< +
;
	variable vp
: bis		( l r -- l' r')
  2dup mid dup @ vp @ @ < IF rot drop cell+ swap ELSE nip THEN
;
: (bsearch)	( l r -- a|0 )
  begin 2dup <> while bis repeat @ vp @ @ <> if dup xor then
;
\ needed? if
: bsearch		( l r v -- a|0)
  here vp ! , (bsearch) [ -1 cells ] literal allot
;
\ then
\ TEST:
\ create first 1 , 3 , 5 , 7 , 9 , here cell - constant last
\ first 0 cells + dup vp ! first last (bsearch) = . .s -1 <0>  ok
\ first 1 cells + dup vp ! first last (bsearch) = . .s -1 <0>
\ last dup vp ! first last (bsearch) = . .s -1 <0>  ok
\ first last 8 bsearch . .s 0 <0>  ok

--
Have a nice day,
humptydumpty

[toc] | [prev] | [next] | [standalone]

#49487

From	humptydumpty <ouatubi@gmail.com>
Date	2016-07-25 09:48 -0700
Message-ID	<cb5bf75a-cfe6-4ead-8a48-371a0ef4a2dd@googlegroups.com>
In reply to	#49457

On Monday, July 25, 2016 at 11:32:57 AM UTC+3, humptydumpty wrote:
> On Monday, July 25, 2016 at 11:10:21 AM UTC+3, Alex Dowad wrote:
> > Here is another crack at it:
> > 
> >     : align<  [ cell 1- invert literal ] and ; \ align downwards to a cell boundary
> > 
> >     : reach ( a b c -- a b c a ) 2 pick ;
> >     : mid   ( l r -- mid ) + 2/ align< ;
> >     : pivot ( l r -- l r mid val ) 2dup mid dup @ ;
> > 
> >     : right-side ( l r mid -- mid+1 r ) rot drop cell + swap ;
> >     : left-side  ( l r mid -- l mid ) nip ;
> >     : bisect     ( l r val -- l' r' ) >r pivot r> < if right-side else left-side then ;
> >     : different? ( a b -- a b f ) 2dup <> ;
> >     : found?     ( val a a -- a|0 ) @ rot <> if drop false then ;
> >     : bsearch    ( val l r -- addr|0 ) begin different? while reach bisect repeat found? ;
> 
> Hi!
> 
> : align<		( u -- u' )
>   [ cell 1- invert ] literal and
> ;
> : mid  		( al ar -- am ; avoid sum overflow)
>   over - 2/ align< +
> ;
> 	variable vp
> : bis		( l r -- l' r')
>   2dup mid dup @ vp @ @ < IF rot drop cell+ swap ELSE nip THEN
> ;
> : (bsearch)	( l r -- a|0 )
>   begin 2dup <> while bis repeat @ vp @ @ <> if dup xor then
> ;
> \ needed? if
> : bsearch		( l r v -- a|0)
>   here vp ! , (bsearch) [ -1 cells ] literal allot
> ;
> \ then
> \ TEST:
> \ create first 1 , 3 , 5 , 7 , 9 , here cell - constant last
> \ first 0 cells + dup vp ! first last (bsearch) = . .s -1 <0>  ok
> \ first 1 cells + dup vp ! first last (bsearch) = . .s -1 <0>
> \ last dup vp ! first last (bsearch) = . .s -1 <0>  ok
> \ first last 8 bsearch . .s 0 <0>  ok
> 
> --
> Have a nice day,
> humptydumpty

Here a comments-corrected version, which hints that 'l' and 'r'
are addresses:

: align<        ( u -- u' )
  [ cell 1- invert ] literal and
;
: mid           ( al ar -- am ; avoid sum overflow)
  over - 2/ align< +
;
        variable vp
: bis           ( al ar -- al' ar')
  2dup mid dup @ vp @ @ < IF rot drop cell+ swap ELSE nip THEN
;
: (bsearch)     ( al ar -- a|0 )
  begin 2dup <> while bis repeat @ vp @ @ <> if dup xor then
;
\ needed? if
: bsearch       ( al ar v -- a|0)
  here vp ! , (bsearch) [ -1 cells ] literal allot
;
\ then
\ TEST:
\ create first 1 , 3 , 5 , 7 , 9 , here cell - constant last
\ first 0 cells + dup vp ! first last (bsearch) = . .s -1 <0>  ok
\ first 1 cells + dup vp ! first last (bsearch) = . .s -1 <0>
\ last dup vp ! first last (bsearch) = . .s -1 <0>  ok
\ first last 8 bsearch . .s 0 <0>  ok

Now, for OP a pair of question to think (not necessarily to answer):

Q1. Why I choose value to be pointed by a variable, and not
 left and right addresses?

Q2. In 'bsearch' I store value in dictionary. Could think of another
version which don't do that? And of course, not store into
other variable.

--
Have a nice day,
humptydumpty

[toc] | [prev] | [next] | [standalone]

#49499 — Re: Implementing binary search without going deeper than top 2 itemson stack?

From	"WJ" <w_a_x_man@yahoo.com>
Date	2016-07-25 21:49 +0000
Subject	Re: Implementing binary search without going deeper than top 2 itemson stack?
Message-ID	<nn61gg$9o5$1@dont-email.me>
In reply to	#49487

humptydumpty wrote:

> On Monday, July 25, 2016 at 11:32:57 AM UTC+3, humptydumpty wrote:
> > On Monday, July 25, 2016 at 11:10:21 AM UTC+3, Alex Dowad wrote:
> > > Here is another crack at it:
> > > 
> > >     : align<  [ cell 1- invert literal ] and ; \ align downwards to a cell boundary
> > > 
> > >     : reach ( a b c -- a b c a ) 2 pick ;
> > >     : mid   ( l r -- mid ) + 2/ align< ;
> > >     : pivot ( l r -- l r mid val ) 2dup mid dup @ ;
> > > 
> > >     : right-side ( l r mid -- mid+1 r ) rot drop cell + swap ;
> > >     : left-side  ( l r mid -- l mid ) nip ;
> > >     : bisect     ( l r val -- l' r' ) >r pivot r> < if right-side else left-side then ;
> > >     : different? ( a b -- a b f ) 2dup <> ;
> > >     : found?     ( val a a -- a|0 ) @ rot <> if drop false then ;
> > >     : bsearch    ( val l r -- addr|0 ) begin different? while reach bisect repeat found? ;
> > 
> > Hi!
> > 
> > : align<		( u -- u' )
> >   [ cell 1- invert ] literal and
> > ;
> > : mid  		( al ar -- am ; avoid sum overflow)
> >   over - 2/ align< +
> > ;
> > 	variable vp
> > : bis		( l r -- l' r')
> >   2dup mid dup @ vp @ @ < IF rot drop cell+ swap ELSE nip THEN
> > ;
> > : (bsearch)	( l r -- a|0 )
> >   begin 2dup <> while bis repeat @ vp @ @ <> if dup xor then
> > ;
> > \ needed? if
> > : bsearch		( l r v -- a|0)
> >   here vp ! , (bsearch) [ -1 cells ] literal allot
> > ;
> > \ then
> > \ TEST:
> > \ create first 1 , 3 , 5 , 7 , 9 , here cell - constant last
> > \ first 0 cells + dup vp ! first last (bsearch) = . .s -1 <0>  ok
> > \ first 1 cells + dup vp ! first last (bsearch) = . .s -1 <0>
> > \ last dup vp ! first last (bsearch) = . .s -1 <0>  ok
> > \ first last 8 bsearch . .s 0 <0>  ok
> > 
> > --
> > Have a nice day,
> > humptydumpty
> 
> Here a comments-corrected version, which hints that 'l' and 'r'
> are addresses:
> 
> : align<        ( u -- u' )
>   [ cell 1- invert ] literal and
> ;
> : mid           ( al ar -- am ; avoid sum overflow)
>   over - 2/ align< +
> ;
>         variable vp
> : bis           ( al ar -- al' ar')
>   2dup mid dup @ vp @ @ < IF rot drop cell+ swap ELSE nip THEN
> ;
> : (bsearch)     ( al ar -- a|0 )
>   begin 2dup <> while bis repeat @ vp @ @ <> if dup xor then
> ;
> \ needed? if
> : bsearch       ( al ar v -- a|0)
>   here vp ! , (bsearch) [ -1 cells ] literal allot
> ;
> \ then
> \ TEST:
> \ create first 1 , 3 , 5 , 7 , 9 , here cell - constant last
> \ first 0 cells + dup vp ! first last (bsearch) = . .s -1 <0>  ok
> \ first 1 cells + dup vp ! first last (bsearch) = . .s -1 <0>
> \ last dup vp ! first last (bsearch) = . .s -1 <0>  ok
> \ first last 8 bsearch . .s 0 <0>  ok

OCaml:

let mid l r = if l>r then None else Some ((l+r)/2) ;;
let next_lr l m r = function
    0 -> None | 1 -> Some (m+1,r) | _ -> Some (l,m-1) ;;

let bin_search item array =
  let rec go l r =
    match mid l r with
        Some m ->
          (match next_lr l m r (compare item array.(m)) with
              Some (l,r) -> go l r
            | _ -> Some m)
      | _ -> None
  in go 0 ((Array.length array) - 1) ;;

# bin_search "qqq" [|"at";"bar";"foo";"see";"zoo"|];;
- : int option = None
# bin_search "at" [|"at";"bar";"foo";"see";"zoo"|];;
- : int option = Some 0
# bin_search "zoo" [|"at";"bar";"foo";"see";"zoo"|];;
- : int option = Some 4
# bin_search "foo" [|"at";"bar";"foo";"see";"zoo"|];;
- : int option = Some 2
# bin_search "see" [|"at";"bar";"foo";"see";"zoo"|];;
- : int option = Some 3
# bin_search "see" [|"at";"bar";"foo";"moooooo";"see";"zoo"|];;
- : int option = Some 4
# bin_search 222 [|0;111;222;333|];;
- : int option = Some 2

-- 
The UK ... is the site of the most widespread and horrifying gang-rape culture
in Europe, in which (literally) thousands, most likely tens of thousands, of
11--16 year native British girls have been gang-raped/enslaved/pimped/tortured
by Muslims (statistics that even the radically pro-Muslim BBC have verified).
www.europeancivilwar.com/how-to-buy-a-gun-in-the-uk/

[toc] | [prev] | [next] | [standalone]

#49497

From	hughaguilar96@gmail.com
Date	2016-07-25 12:15 -0700
Message-ID	<a2c20464-67c7-476a-bb43-06d758f21adc@googlegroups.com>
In reply to	#49457

On Monday, July 25, 2016 at 1:32:57 AM UTC-7, humptydumpty wrote:
> On Monday, July 25, 2016 at 11:10:21 AM UTC+3, Alex Dowad wrote:
> > Here is another crack at it:
> > 
> >     : align<  [ cell 1- invert literal ] and ; \ align downwards to a cell boundary
> > 
> >     : reach ( a b c -- a b c a ) 2 pick ;
> >     : mid   ( l r -- mid ) + 2/ align< ;
> >     : pivot ( l r -- l r mid val ) 2dup mid dup @ ;
> > 
> >     : right-side ( l r mid -- mid+1 r ) rot drop cell + swap ;
> >     : left-side  ( l r mid -- l mid ) nip ;
> >     : bisect     ( l r val -- l' r' ) >r pivot r> < if right-side else left-side then ;
> >     : different? ( a b -- a b f ) 2dup <> ;
> >     : found?     ( val a a -- a|0 ) @ rot <> if drop false then ;
> >     : bsearch    ( val l r -- addr|0 ) begin different? while reach bisect repeat found? ;
> 
> Hi!
> 
> : align<		( u -- u' )
>   [ cell 1- invert ] literal and
> ;
> : mid  		( al ar -- am ; avoid sum overflow)
>   over - 2/ align< +
> ;
> 	variable vp
> : bis		( l r -- l' r')
>   2dup mid dup @ vp @ @ < IF rot drop cell+ swap ELSE nip THEN
> ;
> : (bsearch)	( l r -- a|0 )
>   begin 2dup <> while bis repeat @ vp @ @ <> if dup xor then
> ;
> \ needed? if
> : bsearch		( l r v -- a|0)
>   here vp ! , (bsearch) [ -1 cells ] literal allot
> ;
> \ then
> \ TEST:
> \ create first 1 , 3 , 5 , 7 , 9 , here cell - constant last
> \ first 0 cells + dup vp ! first last (bsearch) = . .s -1 <0>  ok
> \ first 1 cells + dup vp ! first last (bsearch) = . .s -1 <0>
> \ last dup vp ! first last (bsearch) = . .s -1 <0>  ok
> \ first last 8 bsearch . .s 0 <0>  ok
> 
> --
> Have a nice day,
> humptydumpty

You guys don't know what general-purpose code is? If you are going to write a binary-search function, it should work with any data-type! What happens if you later on need to binary-search an array of floats, or an array of structs sorted by some key? I know exactly what will happen --- you will cut-and-paste this binary-search (written specifically for an array of integers) and change it throughout so that it works with whatever data-type your application uses --- I can't actually think of any application that would involve an array of integers, so this cut-and-paste and modify exercise will certainly have to be done the first time your code is actually used in an application.

I already showed my SORT function. This was the API:

: sort { array limit recsiz 'comparer -- }
    ... ;

\ The SORT locals:
\ array             \ the address of the 0th element
\ limit             \ the number of records in the array
\ recsiz            \ the size of a record in the array     \ this must be a multiple of W (FIELD assures this)
\ 'comparer         \ adrX adrY -- X>Y?

I would do something similar with a SEARCH function. I can write code like this easily --- now that the subject of binary-search has come up, I will write a SEARCH function and put it in my next novice-package release (not that I expect anybody to ever use it) --- in the meantime, I will leave it as an exercise for the comp.lang.forth experts.

I'm responding to HumptyDumpty's post because he is the only Forther on comp.lang.forth that I would expect to be capable of succeeding at this challenge (there is nobody on the Forth-200x committee who knows how to general-purpose code) --- come on HumptyDumpty, you can do it!

BTW: I think that HumptyDumpty is the smart one here because he uses a pseudonym on comp.lang.forth. If I had used a pseudonym rather than my real name then Elizabeth Rather would not have known that I was the guy who stole the job at Testra from her (after she makes a sales pitch to a potential customer, she considers that job to be her's, and she will hate forever anybody who steals her job from her) --- Elizabeth Rather would not have felt obliged to attack me and encourage her clown army to say that I'm totally incompetent as a Forth program and also insane --- she would have largely ignored me because a Forther who won't reveal his real name can't be considered to be competition to Forth Inc..

The lesson here is that anybody who is going to program in Forth should conceal his real name so as to avoid being attacked in public and made to feel ashamed of his hobby.

[toc] | [prev] | [next] | [standalone]

#49522

From	humptydumpty <ouatubi@gmail.com>
Date	2016-07-26 00:40 -0700
Message-ID	<e9b5ed95-6f2c-4add-bf10-b545a7908747@googlegroups.com>
In reply to	#49497

On Monday, July 25, 2016 at 10:15:25 PM UTC+3, hughag...@gmail.com wrote:
> On Monday, July 25, 2016 at 1:32:57 AM UTC-7, humptydumpty wrote:
> > On Monday, July 25, 2016 at 11:10:21 AM UTC+3, Alex Dowad wrote:
> > > Here is another crack at it:
> > > 
> > >     : align<  [ cell 1- invert literal ] and ; \ align downwards to a cell boundary
> > > 
> > >     : reach ( a b c -- a b c a ) 2 pick ;
> > >     : mid   ( l r -- mid ) + 2/ align< ;
> > >     : pivot ( l r -- l r mid val ) 2dup mid dup @ ;
> > > 
> > >     : right-side ( l r mid -- mid+1 r ) rot drop cell + swap ;
> > >     : left-side  ( l r mid -- l mid ) nip ;
> > >     : bisect     ( l r val -- l' r' ) >r pivot r> < if right-side else left-side then ;
> > >     : different? ( a b -- a b f ) 2dup <> ;
> > >     : found?     ( val a a -- a|0 ) @ rot <> if drop false then ;
> > >     : bsearch    ( val l r -- addr|0 ) begin different? while reach bisect repeat found? ;
> > 
> > Hi!
> > 
> > : align<		( u -- u' )
> >   [ cell 1- invert ] literal and
> > ;
> > : mid  		( al ar -- am ; avoid sum overflow)
> >   over - 2/ align< +
> > ;
> > 	variable vp
> > : bis		( l r -- l' r')
> >   2dup mid dup @ vp @ @ < IF rot drop cell+ swap ELSE nip THEN
> > ;
> > : (bsearch)	( l r -- a|0 )
> >   begin 2dup <> while bis repeat @ vp @ @ <> if dup xor then
> > ;
> > \ needed? if
> > : bsearch		( l r v -- a|0)
> >   here vp ! , (bsearch) [ -1 cells ] literal allot
> > ;
> > \ then
> > \ TEST:
> > \ create first 1 , 3 , 5 , 7 , 9 , here cell - constant last
> > \ first 0 cells + dup vp ! first last (bsearch) = . .s -1 <0>  ok
> > \ first 1 cells + dup vp ! first last (bsearch) = . .s -1 <0>
> > \ last dup vp ! first last (bsearch) = . .s -1 <0>  ok
> > \ first last 8 bsearch . .s 0 <0>  ok
> > 
> > --
> > Have a nice day,
> > humptydumpty
> 
> You guys don't know what general-purpose code is? If you are going to write a binary-search function, it should work with any data-type! What happens if you later on need to binary-search an array of floats, or an array of structs sorted by some key? I know exactly what will happen --- you will cut-and-paste this binary-search (written specifically for an array of integers) and change it throughout so that it works with whatever data-type your application uses --- I can't actually think of any application that would involve an array of integers, so this cut-and-paste and modify exercise will certainly have to be done the first time your code is actually used in an application.
> 
> I already showed my SORT function. This was the API:
> 
> : sort { array limit recsiz 'comparer -- }
>     ... ;
> 
> \ The SORT locals:
> \ array             \ the address of the 0th element
> \ limit             \ the number of records in the array
> \ recsiz            \ the size of a record in the array     \ this must be a multiple of W (FIELD assures this)
> \ 'comparer         \ adrX adrY -- X>Y?
> 
> I would do something similar with a SEARCH function. I can write code like this easily --- now that the subject of binary-search has come up, I will write a SEARCH function and put it in my next novice-package release (not that I expect anybody to ever use it) --- in the meantime, I will leave it as an exercise for the comp.lang.forth experts.
> 
> I'm responding to HumptyDumpty's post because he is the only Forther on comp.lang.forth that I would expect to be capable of succeeding at this challenge (there is nobody on the Forth-200x committee who knows how to general-purpose code) --- come on HumptyDumpty, you can do it!
> 
> BTW: I think that HumptyDumpty is the smart one here because he uses a pseudonym on comp.lang.forth. If I had used a pseudonym rather than my real name then Elizabeth Rather would not have known that I was the guy who stole the job at Testra from her (after she makes a sales pitch to a potential customer, she considers that job to be her's, and she will hate forever anybody who steals her job from her) --- Elizabeth Rather would not have felt obliged to attack me and encourage her clown army to say that I'm totally incompetent as a Forth program and also insane --- she would have largely ignored me because a Forther who won't reveal his real name can't be considered to be competition to Forth Inc..
> 
> The lesson here is that anybody who is going to program in Forth should conceal his real name so as to avoid being attacked in public and made to feel ashamed of his hobby.

Hi!

I'm not a wise guy, just I like Forth.  I'm convinced that majority from c.l.f.
 can write that (a general purpose binary-search) by means of execution-tokens
 or continuations at execute-time or using various kinds of macros at compile-time.

OP (after reading '1xForth' article) asked if could be done (as an example)
 a binary-search (and proposed one for an array of cell-based values),
 so each definition be one-liner and take mostly 2 parameters
 from data-stack.  If c.l.f. feedback was OK, that only OP could judge..

Have a nice day,
humptydumpty

[toc] | [prev] | [next] | [standalone]

#49627

From	hughaguilar96@gmail.com
Date	2016-07-28 15:11 -0700
Message-ID	<c4cb4fd4-cd93-4429-8fd4-a80fc3705eab@googlegroups.com>
In reply to	#49522

On Tuesday, July 26, 2016 at 12:40:10 AM UTC-7, humptydumpty wrote:
> On Monday, July 25, 2016 at 10:15:25 PM UTC+3, hughag...@gmail.com wrote:
> > On Monday, July 25, 2016 at 1:32:57 AM UTC-7, humptydumpty wrote:
> > > On Monday, July 25, 2016 at 11:10:21 AM UTC+3, Alex Dowad wrote:
> > > > Here is another crack at it:
> > > > 
> > > >     : align<  [ cell 1- invert literal ] and ; \ align downwards to a cell boundary
> > > > 
> > > >     : reach ( a b c -- a b c a ) 2 pick ;
> > > >     : mid   ( l r -- mid ) + 2/ align< ;
> > > >     : pivot ( l r -- l r mid val ) 2dup mid dup @ ;
> > > > 
> > > >     : right-side ( l r mid -- mid+1 r ) rot drop cell + swap ;
> > > >     : left-side  ( l r mid -- l mid ) nip ;
> > > >     : bisect     ( l r val -- l' r' ) >r pivot r> < if right-side else left-side then ;
> > > >     : different? ( a b -- a b f ) 2dup <> ;
> > > >     : found?     ( val a a -- a|0 ) @ rot <> if drop false then ;
> > > >     : bsearch    ( val l r -- addr|0 ) begin different? while reach bisect repeat found? ;
> > > 
> > > Hi!
> > > 
> > > : align<		( u -- u' )
> > >   [ cell 1- invert ] literal and
> > > ;
> > > : mid  		( al ar -- am ; avoid sum overflow)
> > >   over - 2/ align< +
> > > ;
> > > 	variable vp
> > > : bis		( l r -- l' r')
> > >   2dup mid dup @ vp @ @ < IF rot drop cell+ swap ELSE nip THEN
> > > ;
> > > : (bsearch)	( l r -- a|0 )
> > >   begin 2dup <> while bis repeat @ vp @ @ <> if dup xor then
> > > ;
> > > \ needed? if
> > > : bsearch		( l r v -- a|0)
> > >   here vp ! , (bsearch) [ -1 cells ] literal allot
> > > ;
> > > \ then
> > > \ TEST:
> > > \ create first 1 , 3 , 5 , 7 , 9 , here cell - constant last
> > > \ first 0 cells + dup vp ! first last (bsearch) = . .s -1 <0>  ok
> > > \ first 1 cells + dup vp ! first last (bsearch) = . .s -1 <0>
> > > \ last dup vp ! first last (bsearch) = . .s -1 <0>  ok
> > > \ first last 8 bsearch . .s 0 <0>  ok
> > > 
> > > --
> > > Have a nice day,
> > > humptydumpty
> > 
> > You guys don't know what general-purpose code is? If you are going to write a binary-search function, it should work with any data-type! What happens if you later on need to binary-search an array of floats, or an array of structs sorted by some key? I know exactly what will happen --- you will cut-and-paste this binary-search (written specifically for an array of integers) and change it throughout so that it works with whatever data-type your application uses --- I can't actually think of any application that would involve an array of integers, so this cut-and-paste and modify exercise will certainly have to be done the first time your code is actually used in an application.
> > 
> > I already showed my SORT function. This was the API:
> > 
> > : sort { array limit recsiz 'comparer -- }
> >     ... ;
> > 
> > \ The SORT locals:
> > \ array             \ the address of the 0th element
> > \ limit             \ the number of records in the array
> > \ recsiz            \ the size of a record in the array     \ this must be a multiple of W (FIELD assures this)
> > \ 'comparer         \ adrX adrY -- X>Y?
> > 
> > I would do something similar with a SEARCH function. I can write code like this easily --- now that the subject of binary-search has come up, I will write a SEARCH function and put it in my next novice-package release (not that I expect anybody to ever use it) --- in the meantime, I will leave it as an exercise for the comp.lang.forth experts.
> > 
> > I'm responding to HumptyDumpty's post because he is the only Forther on comp.lang.forth that I would expect to be capable of succeeding at this challenge (there is nobody on the Forth-200x committee who knows how to general-purpose code) --- come on HumptyDumpty, you can do it!
> > 
> > BTW: I think that HumptyDumpty is the smart one here because he uses a pseudonym on comp.lang.forth. If I had used a pseudonym rather than my real name then Elizabeth Rather would not have known that I was the guy who stole the job at Testra from her (after she makes a sales pitch to a potential customer, she considers that job to be her's, and she will hate forever anybody who steals her job from her) --- Elizabeth Rather would not have felt obliged to attack me and encourage her clown army to say that I'm totally incompetent as a Forth program and also insane --- she would have largely ignored me because a Forther who won't reveal his real name can't be considered to be competition to Forth Inc..
> > 
> > The lesson here is that anybody who is going to program in Forth should conceal his real name so as to avoid being attacked in public and made to feel ashamed of his hobby.
> 
> Hi!
> 
> I'm not a wise guy, just I like Forth.  I'm convinced that majority from c.l.f.
>  can write that (a general purpose binary-search) by means of execution-tokens
>  or continuations at execute-time or using various kinds of macros at compile-time.
> 
> OP (after reading '1xForth' article) asked if could be done (as an example)
>  a binary-search (and proposed one for an array of cell-based values),
>  so each definition be one-liner and take mostly 2 parameters
>  from data-stack.  If c.l.f. feedback was OK, that only OP could judge..
> 
> Have a nice day,
> humptydumpty

I agree that the majority on c.l.f. are capable of writing a general-purpose binary-search function. I also expect that they aren't going to, because they believe that general-purpose code is not the "Forth Way." All this talk about having one-line colon words that take two parameters is not going to work in real programs. It is a good idea to keep the application code simple, and bury the complexity in code-libraries. So, this ideal can pretty much be realized in the application code, but it is not going to happen in the code-libraries.

Anyway, here is a general-purpose binary-search. This is in the novice-package now. I commented it heavily as the OP is presumably a novice. The OP may not like it though because it is a pretty big function.

: bsearch { array limit target recsiz 'comparer | mid-element -- element|false }
    limit begin  dup while                          \ -- limit
        dup 2/                                      \ -- limit mid
        dup recsiz *  array +  to mid-element                               \ MID-ELEMENT is a pointer into the array
        target mid-element  'comparer execute       \ -- limit mid -1|0|1
        dup 0= if  3drop  mid-element  exit then                            \ if found, return MID-ELEMENT
        0< if                                                               \ if -1, search left side
            nip                                     \ -- new-limit          \ MID is the new limit
        else                                                                \ if 1, search right side
            mid-element recsiz +  to array                                  \ new ARRAY is one element above MID-ELEMENT
            1+  -                                   \ -- new-limit          \ the 1+ is so we don't include the middle element
            then
        repeat ;                                    \ -- false              \ LIMIT is zero, so return it as a false
            
\ The BSEARCH parameters:
\ array             \ the address of the 0th element
\ limit             \ the number of elements in the array
\ target            \ whatever it is that we are trying to match
\ recsiz            \ the size of an element in the array 
\ 'comparer         \ target mid-element -- -1|0|1   -1 if target < mid-element, 0 if target = mid-element, 1 if target > mid-element
\ element|false     \ the found element's address, or FALSE if not found

\ char & comment      \ this is for testing BSEARCH

: comparer ( target mid-element -- -1|0|1 )         \ TARGET = cstr, MID-ELEMENT = pointer to cstr
    swap count  rot @ count  compare ;
    
create array
    c" aaa" hstr ,
    c" bbb" hstr ,
    c" ccc" hstr ,
    c" ddd" hstr ,
    c" eee" hstr ,
    c" fff" hstr ,
    c" ggg" hstr ,
    c" hhh" hstr ,

: testb
    array  8  c" ddd"  w  ['] comparer  bsearch ;
    
&

[toc] | [prev] | [next] | [standalone]

#49700

From	hughaguilar96@gmail.com
Date	2016-07-30 22:47 -0700
Message-ID	<76133506-4d4c-49fc-93fd-d7b4d467ac74@googlegroups.com>
In reply to	#49627

On Thursday, July 28, 2016 at 3:11:31 PM UTC-7, hughag...@gmail.com wrote:
> On Tuesday, July 26, 2016 at 12:40:10 AM UTC-7, humptydumpty wrote:
> > On Monday, July 25, 2016 at 10:15:25 PM UTC+3, hughag...@gmail.com wrote:
> > > On Monday, July 25, 2016 at 1:32:57 AM UTC-7, humptydumpty wrote:
> > > > On Monday, July 25, 2016 at 11:10:21 AM UTC+3, Alex Dowad wrote:
> > > > > Here is another crack at it:
> > > > > 
> > > > >     : align<  [ cell 1- invert literal ] and ; \ align downwards to a cell boundary
> > > > > 
> > > > >     : reach ( a b c -- a b c a ) 2 pick ;
> > > > >     : mid   ( l r -- mid ) + 2/ align< ;
> > > > >     : pivot ( l r -- l r mid val ) 2dup mid dup @ ;
> > > > > 
> > > > >     : right-side ( l r mid -- mid+1 r ) rot drop cell + swap ;
> > > > >     : left-side  ( l r mid -- l mid ) nip ;
> > > > >     : bisect     ( l r val -- l' r' ) >r pivot r> < if right-side else left-side then ;
> > > > >     : different? ( a b -- a b f ) 2dup <> ;
> > > > >     : found?     ( val a a -- a|0 ) @ rot <> if drop false then ;
> > > > >     : bsearch    ( val l r -- addr|0 ) begin different? while reach bisect repeat found? ;
> > > > 
> > > > Hi!
> > > > 
> > > > : align<		( u -- u' )
> > > >   [ cell 1- invert ] literal and
> > > > ;
> > > > : mid  		( al ar -- am ; avoid sum overflow)
> > > >   over - 2/ align< +
> > > > ;
> > > > 	variable vp
> > > > : bis		( l r -- l' r')
> > > >   2dup mid dup @ vp @ @ < IF rot drop cell+ swap ELSE nip THEN
> > > > ;
> > > > : (bsearch)	( l r -- a|0 )
> > > >   begin 2dup <> while bis repeat @ vp @ @ <> if dup xor then
> > > > ;
> > > > \ needed? if
> > > > : bsearch		( l r v -- a|0)
> > > >   here vp ! , (bsearch) [ -1 cells ] literal allot
> > > > ;
> > > > \ then
> > > > \ TEST:
> > > > \ create first 1 , 3 , 5 , 7 , 9 , here cell - constant last
> > > > \ first 0 cells + dup vp ! first last (bsearch) = . .s -1 <0>  ok
> > > > \ first 1 cells + dup vp ! first last (bsearch) = . .s -1 <0>
> > > > \ last dup vp ! first last (bsearch) = . .s -1 <0>  ok
> > > > \ first last 8 bsearch . .s 0 <0>  ok
> > > > 
> > > > --
> > > > Have a nice day,
> > > > humptydumpty
> > > 
> > > You guys don't know what general-purpose code is? If you are going to write a binary-search function, it should work with any data-type! What happens if you later on need to binary-search an array of floats, or an array of structs sorted by some key? I know exactly what will happen --- you will cut-and-paste this binary-search (written specifically for an array of integers) and change it throughout so that it works with whatever data-type your application uses --- I can't actually think of any application that would involve an array of integers, so this cut-and-paste and modify exercise will certainly have to be done the first time your code is actually used in an application.
> > > 
> > > I already showed my SORT function. This was the API:
> > > 
> > > : sort { array limit recsiz 'comparer -- }
> > >     ... ;
> > > 
> > > \ The SORT locals:
> > > \ array             \ the address of the 0th element
> > > \ limit             \ the number of records in the array
> > > \ recsiz            \ the size of a record in the array     \ this must be a multiple of W (FIELD assures this)
> > > \ 'comparer         \ adrX adrY -- X>Y?
> > > 
> > > I would do something similar with a SEARCH function. I can write code like this easily --- now that the subject of binary-search has come up, I will write a SEARCH function and put it in my next novice-package release (not that I expect anybody to ever use it) --- in the meantime, I will leave it as an exercise for the comp.lang.forth experts.
> > > 
> > > I'm responding to HumptyDumpty's post because he is the only Forther on comp.lang.forth that I would expect to be capable of succeeding at this challenge (there is nobody on the Forth-200x committee who knows how to general-purpose code) --- come on HumptyDumpty, you can do it!
> > > 
> > > BTW: I think that HumptyDumpty is the smart one here because he uses a pseudonym on comp.lang.forth. If I had used a pseudonym rather than my real name then Elizabeth Rather would not have known that I was the guy who stole the job at Testra from her (after she makes a sales pitch to a potential customer, she considers that job to be her's, and she will hate forever anybody who steals her job from her) --- Elizabeth Rather would not have felt obliged to attack me and encourage her clown army to say that I'm totally incompetent as a Forth program and also insane --- she would have largely ignored me because a Forther who won't reveal his real name can't be considered to be competition to Forth Inc..
> > > 
> > > The lesson here is that anybody who is going to program in Forth should conceal his real name so as to avoid being attacked in public and made to feel ashamed of his hobby.
> > 
> > Hi!
> > 
> > I'm not a wise guy, just I like Forth.  I'm convinced that majority from c.l.f.
> >  can write that (a general purpose binary-search) by means of execution-tokens
> >  or continuations at execute-time or using various kinds of macros at compile-time.
> > 
> > OP (after reading '1xForth' article) asked if could be done (as an example)
> >  a binary-search (and proposed one for an array of cell-based values),
> >  so each definition be one-liner and take mostly 2 parameters
> >  from data-stack.  If c.l.f. feedback was OK, that only OP could judge..
> > 
> > Have a nice day,
> > humptydumpty
> 
> I agree that the majority on c.l.f. are capable of writing a general-purpose binary-search function. I also expect that they aren't going to, because they believe that general-purpose code is not the "Forth Way." All this talk about having one-line colon words that take two parameters is not going to work in real programs. It is a good idea to keep the application code simple, and bury the complexity in code-libraries. So, this ideal can pretty much be realized in the application code, but it is not going to happen in the code-libraries.
> 
> Anyway, here is a general-purpose binary-search. This is in the novice-package now. I commented it heavily as the OP is presumably a novice. The OP may not like it though because it is a pretty big function.
> 
> : bsearch { array limit target recsiz 'comparer | mid-element -- element|false }
>     limit begin  dup while                          \ -- limit
>         dup 2/                                      \ -- limit mid
>         dup recsiz *  array +  to mid-element                               \ MID-ELEMENT is a pointer into the array
>         target mid-element  'comparer execute       \ -- limit mid -1|0|1
>         dup 0= if  3drop  mid-element  exit then                            \ if found, return MID-ELEMENT
>         0< if                                                               \ if -1, search left side
>             nip                                     \ -- new-limit          \ MID is the new limit
>         else                                                                \ if 1, search right side
>             mid-element recsiz +  to array                                  \ new ARRAY is one element above MID-ELEMENT
>             1+  -                                   \ -- new-limit          \ the 1+ is so we don't include the middle element
>             then
>         repeat ;                                    \ -- false              \ LIMIT is zero, so return it as a false
>             
> \ The BSEARCH parameters:
> \ array             \ the address of the 0th element
> \ limit             \ the number of elements in the array
> \ target            \ whatever it is that we are trying to match
> \ recsiz            \ the size of an element in the array 
> \ 'comparer         \ target mid-element -- -1|0|1   -1 if target < mid-element, 0 if target = mid-element, 1 if target > mid-element
> \ element|false     \ the found element's address, or FALSE if not found
> 
> \ char & comment      \ this is for testing BSEARCH
> 
> : comparer ( target mid-element -- -1|0|1 )         \ TARGET = cstr, MID-ELEMENT = pointer to cstr
>     swap count  rot @ count  compare ;
>     
> create array
>     c" aaa" hstr ,
>     c" bbb" hstr ,
>     c" ccc" hstr ,
>     c" ddd" hstr ,
>     c" eee" hstr ,
>     c" fff" hstr ,
>     c" ggg" hstr ,
>     c" hhh" hstr ,
> 
> : testb
>     array  8  c" ddd"  w  ['] comparer  bsearch ;
>     
> &

In my code above, the array's elements can be any size --- the RECSIZ parameter is given to let BSEARCH know what the size of the elements is --- the elements can be records (structs) or can be pointers (RECSIZ = W) to records.

The reason why I point this out is that I have been criticized for this previously:

On Monday, February 17, 2014 at 7:53:18 AM UTC-7, Alex McDonald wrote:
> on 16/02/2014 11:21:59,  wrote:
> > On Sunday, February 16, 2014 2:48:34 AM UTC-7, Alex McDonald wrote:
> >> You and I have had a long discussion about the poor quality of the
> >> implementation of popular sorts you wrote in your novice package, where
> >> you have serious misunderstandings of how pointers work.
> > 
> > My SORT works fine (it uses the HeapSort algorithm by default,
> > although I a lso have a QuickSort version), and I'm pretty sure that I
> > know how pointers work.
> 
> We had a long discussion about how your sorts moved records (fixed length
> areas of memory) rather than adjusted a list of pointers, and was going
> to be slow on anything other than a small number of short records due to
> the amount of data being moved.

The criticism was that I should have forced the user to work only with arrays of pointers to structs (RECSIZ would be a constant W rather than a parameter), and not allowed the user to have arrays of structs. It seems better to me to make RECSIZ a parameter and allow the user to choose which he wants.

I doubt that it makes much difference in regard to speed. We do have this line of code:
    dup recsiz *  array +  to mid-element    
If we were working with the 65c02, that multiplication would be a major problem speed-wise (using a multiplication rather than a shift by a constant would make the function about two orders of magnitude slower). On a modern processor however, a multiplication is almost as fast as a shift.

I think that a lot of times when people talk about "Forth Style" and the "Forth Way," they are emulating Charles Moore's programming. Charles Moore got kicked out of Forth Inc. in 1982 when the 65c02 and Z80 were still state of the art (the PDP-11 did have multiplication and division, but those computers cost tens of thousands of dollars). All of Charles Moore's programming from the 1970s and very early 1980s was necessarily for extremely limited processors --- these limitations haven't been an issue for over three decades --- it is a mistake in the year 2016 to faithfully follow the "Forth Way" from the 1970s, but instead we should develop a new "Forth Way" that is more appropriate to the 21st century.

Modern computers are extremely fast. My laptop that I bought at WalMart for less than $400 would have been worth many hundreds of thousands of dollars in 1982 (I don't even know if such a powerful computer existed in those days, for any price). Nowadays it is not worthwhile to worry about whether a multiplication or a shift is being done, as the difference is a matter of nanoseconds. It is much more important to write programs that work --- having general-purpose data-structures available helps a lot!

[toc] | [prev] | [next] | [standalone]

#49525

From	josv@planet.nl
Date	2016-07-26 01:53 -0700
Message-ID	<944a7e5d-2e29-4eab-8fa8-fa0abefbcbc0@googlegroups.com>
In reply to	#49497

Hi,

See in the latest version of Win32Forth: 
~\win32forth\apps\Player4\mshell_r.f

Characteristics:
Uses relative as pointers.  So there is no need
  to generate the same pointers again when they are saved in a file.
Multiple keys can be used and sorted in one go.
The number of keys is only limited by the unused size of the stack.
Each key can be sorted in an ascending or descending way.
A key may contain a byte, word, cell, float or a string.
The sort is case-insensitive for strings.
Easy to expand to sort doubles etc.
Uses a shellsort.

Jos

On 25 july 2016 21:15:25 UTC+2 hughag...@gmail.com wrote:
> On Monday, July 25, 2016 at 1:32:57 AM UTC-7, humptydumpty wrote:
> > On Monday, July 25, 2016 at 11:10:21 AM UTC+3, Alex Dowad wrote:
> > > Here is another crack at it:
> > > 
> > >     : align<  [ cell 1- invert literal ] and ; \ align downwards to a cell boundary
> > > 
> > >     : reach ( a b c -- a b c a ) 2 pick ;
> > >     : mid   ( l r -- mid ) + 2/ align< ;
> > >     : pivot ( l r -- l r mid val ) 2dup mid dup @ ;
> > > 
> > >     : right-side ( l r mid -- mid+1 r ) rot drop cell + swap ;
> > >     : left-side  ( l r mid -- l mid ) nip ;
> > >     : bisect     ( l r val -- l' r' ) >r pivot r> < if right-side else left-side then ;
> > >     : different? ( a b -- a b f ) 2dup <> ;
> > >     : found?     ( val a a -- a|0 ) @ rot <> if drop false then ;
> > >     : bsearch    ( val l r -- addr|0 ) begin different? while reach bisect repeat found? ;
> > 
> > Hi!
> > 
> > : align<		( u -- u' )
> >   [ cell 1- invert ] literal and
> > ;
> > : mid  		( al ar -- am ; avoid sum overflow)
> >   over - 2/ align< +
> > ;
> > 	variable vp
> > : bis		( l r -- l' r')
> >   2dup mid dup @ vp @ @ < IF rot drop cell+ swap ELSE nip THEN
> > ;
> > : (bsearch)	( l r -- a|0 )
> >   begin 2dup <> while bis repeat @ vp @ @ <> if dup xor then
> > ;
> > \ needed? if
> > : bsearch		( l r v -- a|0)
> >   here vp ! , (bsearch) [ -1 cells ] literal allot
> > ;
> > \ then
> > \ TEST:
> > \ create first 1 , 3 , 5 , 7 , 9 , here cell - constant last
> > \ first 0 cells + dup vp ! first last (bsearch) = . .s -1 <0>  ok
> > \ first 1 cells + dup vp ! first last (bsearch) = . .s -1 <0>
> > \ last dup vp ! first last (bsearch) = . .s -1 <0>  ok
> > \ first last 8 bsearch . .s 0 <0>  ok
> > 
> > --
> > Have a nice day,
> > humptydumpty
> 
> You guys don't know what general-purpose code is? If you are going to write a binary-search function, it should work with any data-type! What happens if you later on need to binary-search an array of floats, or an array of structs sorted by some key? I know exactly what will happen --- you will cut-and-paste this binary-search (written specifically for an array of integers) and change it throughout so that it works with whatever data-type your application uses --- I can't actually think of any application that would involve an array of integers, so this cut-and-paste and modify exercise will certainly have to be done the first time your code is actually used in an application.
> 
> I already showed my SORT function. This was the API:
> 
> : sort { array limit recsiz 'comparer -- }
>     ... ;
> 
> \ The SORT locals:
> \ array             \ the address of the 0th element
> \ limit             \ the number of records in the array
> \ recsiz            \ the size of a record in the array     \ this must be a multiple of W (FIELD assures this)
> \ 'comparer         \ adrX adrY -- X>Y?
> 
> I would do something similar with a SEARCH function. I can write code like this easily --- now that the subject of binary-search has come up, I will write a SEARCH function and put it in my next novice-package release (not that I expect anybody to ever use it) --- in the meantime, I will leave it as an exercise for the comp.lang.forth experts.
> 
> I'm responding to HumptyDumpty's post because he is the only Forther on comp.lang.forth that I would expect to be capable of succeeding at this challenge (there is nobody on the Forth-200x committee who knows how to general-purpose code) --- come on HumptyDumpty, you can do it!
> 
> BTW: I think that HumptyDumpty is the smart one here because he uses a pseudonym on comp.lang.forth. If I had used a pseudonym rather than my real name then Elizabeth Rather would not have known that I was the guy who stole the job at Testra from her (after she makes a sales pitch to a potential customer, she considers that job to be her's, and she will hate forever anybody who steals her job from her) --- Elizabeth Rather would not have felt obliged to attack me and encourage her clown army to say that I'm totally incompetent as a Forth program and also insane --- she would have largely ignored me because a Forther who won't reveal his real name can't be considered to be competition to Forth Inc..
> 
> The lesson here is that anybody who is going to program in Forth should conceal his real name so as to avoid being attacked in public and made to feel ashamed of his hobby.

[toc] | [prev] | [next] | [standalone]

#49699

From	mhx@iae.nl
Date	2016-07-30 21:31 -0700
Message-ID	<e7823706-ce44-4288-90cc-ebb73976c7f1@googlegroups.com>
In reply to	#49457

On Monday, July 25, 2016 at 10:32:57 AM UTC+2, humptydumpty wrote:
> On Monday, July 25, 2016 at 11:10:21 AM UTC+3, Alex Dowad wrote:
> > Here is another crack at it:
> > 
> >     : align<  [ cell 1- invert literal ] and ; \ align downwards to a cell boundary
> > 
> >     : reach ( a b c -- a b c a ) 2 pick ;
> >     : mid   ( l r -- mid ) + 2/ align< ;
> >     : pivot ( l r -- l r mid val ) 2dup mid dup @ ;
> > 
> >     : right-side ( l r mid -- mid+1 r ) rot drop cell + swap ;
> >     : left-side  ( l r mid -- l mid ) nip ;
> >     : bisect     ( l r val -- l' r' ) >r pivot r> < if right-side else left-side then ;
> >     : different? ( a b -- a b f ) 2dup <> ;
> >     : found?     ( val a a -- a|0 ) @ rot <> if drop false then ;
> >     : bsearch    ( val l r -- addr|0 ) begin different? while reach bisect repeat found? ;
> 
> Hi!
> 
> : align<		( u -- u' )
>   [ cell 1- invert ] literal and
> ;
> : mid  		( al ar -- am ; avoid sum overflow)
>   over - 2/ align< +
> ;
> 	variable vp
> : bis		( l r -- l' r')
>   2dup mid dup @ vp @ @ < IF rot drop cell+ swap ELSE nip THEN
> ;
> : (bsearch)	( l r -- a|0 )
>   begin 2dup <> while bis repeat @ vp @ @ <> if dup xor then
> ;
> \ needed? if
> : bsearch		( l r v -- a|0)
>   here vp ! , (bsearch) [ -1 cells ] literal allot
> ;
> \ then
> \ TEST:
> \ create first 1 , 3 , 5 , 7 , 9 , here cell - constant last
> \ first 0 cells + dup vp ! first last (bsearch) = . .s -1 <0>  ok
> \ first 1 cells + dup vp ! first last (bsearch) = . .s -1 <0>
> \ last dup vp ! first last (bsearch) = . .s -1 <0>  ok
> \ first last 8 bsearch . .s 0 <0>  ok
> 
> --
> Have a nice day,
> humptydumpty

I like this style when the goal is to
just write BSEARCH. However, encountering
all these definitions in a real program
would force me to read and remember them
all, because I don't know which ones will
be used stand-alone and which ones are only
internal factors.

When bsearch were just a concatenation of all
the one-liners (possibly with the names as a
comment) it would be just fine for me, too.
However, I could then just look at the comment
for BSEARCH to decide if I need to read it to
understand the rest of the code or not.

For writing BSEARCH it is clear that the factors
are not reused, so it is a waste of effort, space
and CPU cycles.

You might say all these factors make it easy to
test the code. However, I think that is not true
here (and not in general). To test, the test must
already be given. If not, one must analyze the word
to find the type and special properties of its 
arguments (stack, memory, etc.),
and of course the outcome and corner cases. We can
see that in almost no cases Forth authors supply
test code (for the factors). If they did the code
trees would be unreadable for the test forests :-)

Having a good command line editor with cut and
paste takes away the need for separate definitions,
and if there are no test cases, works just as well.

There is another observation we can make here. Not
only are the factors of bsearch not used *here*,
the end test suggests that useful general factors
of the underlying Forth system are also not used:

  here cell - constant XX
  + dup YY !
  = . .s

These factors are not used because the author
doesn't remember them, or considers them
non-standard, or thinks it is easier to write
them out than to look them up.

-marcel

[toc] | [prev] | [next] | [standalone]

Page 1 of 2 [1] 2 Next page →

csiph-web

Implementing binary search without going deeper than top 2 items on stack?

Contents

#49393 — Implementing binary search without going deeper than top 2 items on stack?

#49395

#49400

#49445

#49446

#49448

#49449

#49453

#49484

#49492

#49455

#49457

#49487

#49499 — Re: Implementing binary search without going deeper than top 2 itemson stack?

#49497

#49522

#49627

#49700

#49525

#49699