A *

Algemene discussies en vragen omtrent Liberty BASIC programma's. Stuur zoveel mogelijk delen van listings (snippets) in als je hulp wilt.

Moderators: anthonio, Abcott

A *

Berichtdoor bluatigro » vr aug 17, 2012 12:16 pm

dit kan je bv doen met n arraylist
Code: Selecteer alles


WindowWidth  = DisplayWidth
WindowHeight = DisplayHeight

nomainwin

global maxx , maxy , source , target , cut$ , o$ , c$ , nx , ny
global false , true , pi , sorted , show

maxx  = 10
maxy  = 10
cut$  = "|"
false = 0
true  = not( false) ' or ANY NON-ZERO value
pi    = atn( 1 ) * 4
sorted = false 'sort lookat-cels on distance target
show = true  'show red seartch patern
''                        parent
dim maze( maxx * maxy + 10 ) , p( maxx * maxy + 10 )

for y = 0 to 10
  read q$
  for x = 1 to len( q$ )
    a =val( mid$( q$ , x , 1 ) )
    if a = 2 then source = index( x , y )
    if a = 3 then target = index( x , y )
    maze( index( x , y ) ) = a
  next x
next y

data "1111111111"
data "1........1"
data "1........1"
data "1...111..1"
data "1...1....1"
data "1.2.1..3.1"
data "1...1....1"
data "1..11....1"
data "1........1"
data "1........1"
data "1111111111"

open "A*" for graphics_nsb as #m

  #m "trapclose [quit]"
  #m "goto 120 100 ; down ; fill cyan"
  for i = 1 to maxx
    for j = 0 to maxy
      call point i , j , maze( index( i , j ) )
    next j
  next i

  #m "flush"

  ny = int( source / maxx )
  nx = source - ny * maxx
  o$ = push$( o$ , str$( source ) , 0 )
  ty = int( target / maxx )
  tx = source - ty * maxx

  while o$ <>"" and now <>target
    tel = 0
    for q = 0 to 7 / 4 * pi step pi / 4
      now     = index( nx , ny )
      lookat  = index( nx + sign( sin( q ) ) , ny + sign( cos( q ) ) )
      if maze( lookat ) <> 1 _
      and not( element( c$ , str$( lookat ) ) ) _
      and not( element( o$ , str$( lookat ) ) ) then
        if p( lookat ) = 0 then p( lookat )  = now
        mem( tel ) = lookat
        ly = int( lookat / maxx )
        lx = lookat - ly * maxx
        af( tel ) = sqr( ( lx - tx ) ^ 2 + ( ly - ty ) ^ 2 )

        if lookat = target then now = target '<< this line has no efect why ?
        tel = tel + 1
        if show then
          t$ = time$()
          while t$ = time$()
          wend
          call point lx , ly , 5
        end if
        if not( sorted ) then
            o$ = push$( o$, str$( lookat ) , false )
        end if
      end if
    next q
    if sorted then
      for h = 0 to tel - 1
        for l = 1 to h - 1
          if af( h ) > af( l ) then
            q = af( h )
            af( h ) = af( l )
            af( l ) = q
            q = mem( h )
            mem( h ) = mem( l )
            mem( l ) = q
          end if
        next l
      next h
      if tel > 0 then
        for i = 0 to tel - 1
          o$ = push$( o$ , str$( mem( i ) ) , false )
        next i
      end if
    end if
    c$   = push$( c$ , str$( now ) , true )
    o$   = pop$( o$ )
    now  = val( top$( o$ ) )
    ny   = int( now / maxx )
    nx   = now - ny * maxx

    scan

  wend

  if o$ = "" then
    notice "No path found !!"
  else
    t =target
    while t <> source
      t = p( t )
      ny = int( t / maxx )
      nx = t -ny * maxx
      call point nx , ny , 4
    wend
  end if

wait

sub point x , y , no
  select case no
    case 1
      '#m "color darkred"
      #m "backcolor darkred"
    case 2
      '#m "color blue"
      #m "backcolor blue"
    case 3
      '#m "color green"
      #m "backcolor green"
    case 4
      '#m "color yellow"
      #m "backcolor yellow"
    case 5
      #m "backcolor red"
    case else
      '#m "color black"
      #m "backcolor darkgray"
  end select

  #m "place " ; x * 40 + 100 ; " " ; y * 40 + 100

  select case no
    case 4
      #m "circlefilled 7"
    case 5
      #m "circlefilled 10"
    case else
      #m "circlefilled 20"
  end select

end sub

[quit]
  close #m
end

function sign( x )
  sign = 0
  if x < 0 then sign = -1
  if x > 0 then sign = 1
end function

function index( x , y )
  index = x + y * maxx
end function

''                                 stack stuff
end
function bool$( x )
  if x then
    uit$ = "TRUE"
  else
    uit$ = "FALSE"
  end if
  bool$ = uit$
end function

function push$( stack$ , object$ , l )
  if object$ <> cut$ then
    if l <> 0 then
      push$ = object$ + cut$ + stack$
    else
      push$ = stack$ + object$ + cut$
      ''push$ = stack$ + cut$ + object$
    end if
  else
    push$ = stack$
  end if
end function

function pop$( stack$ )
''delete last object$
  i = instr( stack$ , cut$ )
  if stack$ = "" then pop$ = ""
''get right side of stack
  pop$ = mid$( stack$ , i + 1 , len( stack$ ) -i )
end function

function top$( stack$ )
''read last object$
  i = instr( stack$ , cut$ )
  if stack$ = "" then
    top$ = ""
  else
    top$ = mid$( stack$ , 1 , i - 1 ) '   <<<<<<<<
  end if
end function

function size( a$ )
  result = 0
  for i = 1 to len( a$ )
    if mid$( a$ , i , 1 ) = cut$ then result = result + 1
  next i
  size = result
end function

function insertAt$( a$ , item$ , i )
  p = 1
  result$ = ""
  max = size( a$ )
  if i < 0 then i = max + 2 - abs( i )
  while p < i
    result$ = push$( result$ , word$( a$ , p , cut$ ) , false )
    p = p + 1
  wend
  result$ = push$( result$ , item$ , false )
  while p <= max
    result$ = push$( result$ , word$( a$ , p , cut$ ) , false )
    p = p + 1
  wend
  insertAt$ = result$
end function

function insertSorted$( a$ , item$ , no , isStr )
  p = 1
  result$ = ""
  max = size( a$ )
  done = false
  while p <= max and not( done )
    m$ = word$( a$ , p , cut$ )
    mp$ = word$( m$ , no )
    ip$ = word$( item$ , no )
    result$ = push$( result$ , m$ , false )
    if isStr then
      if mp$ <= ip$ then
        result$ = push$( result$ , item$ , false )
        done = true
      end if
    else
      if val( mp$ ) <= val( ip$ ) then
        result$ = push$( result$ , item$ , false )
        done = true
      end if
    end if
    p = p + 1
  wend
  while p < max
    m$ = word$( a$ , p , cut$ )
    result$ = push$( result$ , m$ , false )
    p = p + 1
  wend
  insertSorted$ = result$
end function

function sort$( a$ , no , isStr )
  max = size( a$ )
  for i = 1 to max
    result$ = insertSorted$( result$ , word$( a$ , i , cut$ ) , no , isStr )
  next i
  sort$ = result$
end function

function remove$( a$ , item$ )
  p = 1
  result$ = ""
  max = size( a$ )
  while p <= max
    if word$( a$ , p , cut$ ) <> item$ then
      result$ = push$( result$ , word$( a$ , p , cut$ ) , false )
    end if
    p = p + 1
  wend
  remove$ = result$
end function

function removeAt$( a$ , i )
  p = 1
  result$ = ""
  max = size( a$ )
  if i < 0 then i = max + 1 - abs( i )
  while p <= max
    if p <> i then
      result$ = push$( result$ , word$( a$ , p , cut$ ) , false )
    end if
    p = p + 1
  wend
  removeAt$ = result$
end function

function reverse$( a$ )
  p = 1
  max = size( a$ )
  while p <= max
    result$ = push$( result$ , word$( a$ , p , cut$ ) , true )
    p = p + 1
  wend
  reverse$ = result$
end function

function part$( a$ , b , e )
  max = size( a$ )
  if b < 0 then b = max + 1 - abs( b )
  if e < 0 then e = max + 1 - abs( e )
  for i = b to e
    r$ = push$( r$ , word$( a$ , i , cut$ ) , false )
  next i
  part$ = r$
end function

function element( a$ , item$ )
  p = instr( cut$ + a$ , cut$ + item$ + cut$ )
  element = p > 0
end function

function suffle$( a$ )
  max = size( a$ )
  dice = int( rnd( 0 ) * max ) + 1
  seed$ = word$( a$ , dice , cut$ )
  for i = 2 to max
    dice = int( rnd( 0 ) * ( max - i ) ) + 1
    p$ = word$( a$ , dice , cut$ )
    uit$ = push$( uit$ , p$ , false )
    a$ = removeAt$( a$ , dice )
  next i
  suffle$ = uit$
end function
bluatigro
 
Berichten: 306
Geregistreerd: za sep 27, 2008 6:01 pm

Keer terug naar Liberty BASIC Code

Wie is er online

Gebruikers op dit forum: Geen geregistreerde gebruikers. en 2 gasten

cron