LB Booster
« machine learing : clustering data »

Welcome Guest. Please Login or Register.
Apr 1st, 2018, 03:34am



ATTENTION MEMBERS: Conforums will be closing it doors and discontinuing its service on April 15, 2018.
We apologize Conforums does not have any export functions to migrate data.
Ad-Free has been deactivated. Outstanding Ad-Free credits will be reimbursed to respective payment methods.

Thank you Conforums members.
Speed up Liberty BASIC programs by up to ten times!
Compile Liberty BASIC programs to compact, standalone executables!
Overcome many of Liberty BASIC's bugs and limitations!
LB Booster Resources
LB Booster documentation
LB Booster Home Page
LB Booster technical Wiki
Just BASIC forum
BBC BASIC Home Page
Liberty BASIC forum (the original)

« Previous Topic | Next Topic »
Pages: 1  Notify Send Topic Print
 thread  Author  Topic: machine learing : clustering data  (Read 179 times)
bluatigro
Full Member
ImageImageImage


member is offline

Avatar




PM

Gender: Male
Posts: 111
xx machine learing : clustering data
« Thread started on: Sep 30th, 2016, 12:19pm »


error :
the code shoot stop when it finds the solution
but it is a infinite loop

Code:
global imax , dmax , kl$ , num.clusters
WindowWidth = DisplayWidth
WindowHeight = DisplayHeight
global winx , winy
winx = WindowWidth
winy = WindowHeight
imax = 63
dmax = 1
kl$ = "red green blue yellow pink cyan"
dim raw( imax , dmax ) , i( imax )

for i = 0 to imax
  raw( i , 0 ) =  ( i mod 4 ) + ( i / 4 mod 2 ) * 300 + 50
  raw( i , 1 ) = ( i / 8 mod 4 ) + ( i / 32 mod 2 ) * 300 + 50
next i

num.clusters = 4

dim c( num.clusters , dmax ) , tot( num.clusters ) _
, tel( num.clusters )
for i = 0 to imax
  i( i ) = dice( num.clusters )
next i
nomainwin
open "k means demo" for graphics as #m
  #m "trapclose [quit]"
  call showdata
  call sleep 1000
  fl = 1
  while fl
    fl = 0
    for i = 0 to imax
      scan
      olddist = dist()
      old = i( i )
      d = dice( num.clusters )
      while d = old
        d = dice( num.clusters )
        i( i ) = d
      wend
      if olddist < dist() then
        i( i ) = old
      else
        fl = 1
      end if
    next i
    call showdata
    call sleep 250
  wend
  notice "READY !!"
wait
[quit]
  close #m
end
function range( l , h )
  range = rnd(0) * ( h - l ) + l
end function
function dice( x )
  dice = int( rnd(0) * ( int( x ) - 1e-10 ) )
end function
function dist()
''first calc certrums
  for i = 0 to dmax
    for j = 0 to num.clusters
      tot( j ) = 0
      tel( j ) = 0
    next j
    for j = 0 to imax
      tot( i( j ) ) = tot( i( j ) ) + raw(j,i)
      tel( i( j ) ) = tel( i( j ) ) + 1
    next j
    for j = 0 to imax
      c( i( j ) , i ) = tot( i( j ) ) / ( tel( i( j ) ) + 1 )
    next j
  next i
''then calc tot sum
  uit = 0
  for i = 0 to imax
    sum = 0
    for j = 0 to dmax
      sum = sum + ( raw( i , j ) _
      - c( i( i ) , j ) ) ^ 2
    next j
    uit = uit + sqr( sum )
  next i
  dist = uit
end function
sub sleep ms
  CallDLL #kernel32, "Sleep" _
  , ms As long _
  , ret As void
end sub
sub showdata
  #m "fill black"
  #m "size 7"
  for i = 0 to imax
    #m "goto " ; 50 + raw( i , 0 ) _
    ; " " ; 50 + raw( i , 1 )
    #m "color " ; word$( kl$ , i( i ) + 1 )
    #m "backcolor " ; word$( kl$ , i( i ) + 1 )
    #m "down"
    #m "circlefilled 5"
    #m "up"
  next i
  for i = 0 to num.clusters - 1
    #m "goto " ; 50 + c( i , 0 ) _
    ; " " ; 50 + c( i , 1 )
    #m "color " ; word$( kl$ , i + 1 )
    #m "backcolor white"
    #m "down"
    #m "circle 50"
    #m "up"
  next i
end sub
 
User IP Logged

Pages: 1  Notify Send Topic Print
« Previous Topic | Next Topic »

| |

This forum powered for FREE by Conforums ©
Terms of Service | Privacy Policy | Conforums Support | Parental Controls