Fischer Random Chess start positions

Post your FreeBASIC source, examples, tips and tricks here. Please don’t post code without including an explanation.
Post Reply
Roland Chastain
Posts: 1004
Joined: Nov 24, 2011 19:49
Location: France
Contact:

Fischer Random Chess start positions

Post by Roland Chastain »

Hello! Here is a program which generates "Fischer Random Chess" start positions. It uses the method described in this document.

Code: Select all

' fischerandom.bi
' Generate start positions of Fischer Random Chess 
' https://www.dwheeler.com/essays/Fischer_Random_Chess.html

declare function StartPosition overload(a as integer, b as integer, c as integer, d as integer, e as integer) as string
declare function StartPosition(i as integer) as string
declare function StartPosition() as string

function StartPosition overload(a as integer, b as integer, c as integer, d as integer, e as integer) as string
  if (a < 1) or (a > 4) _
  or (b < 1) or (b > 4) _
  or (c < 1) or (c > 6) _
  or (d < 1) or (d > 5) _
  or (e < 1) or (e > 4) then
    return ""
  end if
  
  dim result as string = String(8, ".")
  dim i as integer
  
  i = 2 * a - 2
  result[i] = Asc("B")
  i = 2 * b - 1
  result[i] = Asc("B")
  
  i = 0
  while result[i] <> Asc(".")
    i += 1
  wend
  while c > 1
    i += 1
    while result[i] <> Asc(".")
      i += 1
    wend
    c -= 1
  wend
  result[i] = Asc("Q")
  
  i = 0
  while result[i] <> Asc(".")
    i += 1
  wend
  while d > 1
    i += 1
    while result[i] <> Asc(".")
      i += 1
    wend
    d -= 1
  wend
  result[i] = Asc("N")
  
  i = 0
  while result[i] <> Asc(".")
    i += 1
  wend
  while e > 1
    i += 1
    while result[i] <> Asc(".")
      i += 1
    wend
    e -= 1
  wend
  result[i] = Asc("N")
  
  i = 0
  while result[i] <> Asc(".")
    i += 1
  wend
  result[i] = Asc("R")
  while result[i] <> Asc(".")
    i += 1
  wend
  result[i] = Asc("K")
  while result[i] <> Asc(".")
    i += 1
  wend
  result[i] = Asc("R")
  
  return LCase(result) & "/pppppppp/8/8/8/8/PPPPPPPP/" & result & " w KQkq - 0 1"
end function

function StartPosition(i as integer) as string
  if (i < 1) or (i > 1920) then
    return ""
  end if
  
  dim as integer a, b, c, d, e, f
  
  f = i - 1
  a = (f \ 480) + 1
  f mod= 480
  b = (f \ 120) + 1
  f mod= 120
  c = (f \ 20) + 1
  f mod= 20
  d = (f \ 4) + 1
  f mod= 4
  e = f + 1
  
  return StartPosition(a, b, c, d, e)
end function

function StartPosition() as string
  return StartPosition( _
    Int(Rnd * 4) + 1, _
    Int(Rnd * 4) + 1, _
    Int(Rnd * 6) + 1, _
    Int(Rnd * 5) + 1, _
    Int(Rnd * 4) + 1 _
  )
end function

Code: Select all

' demo.bas

#include "fischerandom.bi"

Randomize Timer

? StartPosition(2, 3, 3, 2, 3)
? StartPosition(767)
? StartPosition()
Last edited by Roland Chastain on May 16, 2018 20:23, edited 9 times in total.
grindstone
Posts: 862
Joined: May 05, 2015 5:35
Location: Germany

Re: Fischer Random Chess start positions

Post by grindstone »

Very interesting! I've never heared of "Fischer Random Chess" before.
Roland Chastain
Posts: 1004
Joined: Nov 24, 2011 19:49
Location: France
Contact:

Re: Fischer Random Chess start positions

Post by Roland Chastain »

@grindstone

Thank you for your answer. Yes, it's interesting. If I have correctly understood, all the rules are the same, except for castling.

I have updated the code. Please see first post.
Post Reply