'Evolution of products Ec 126 assignment.
'by Julius Su

RANDOMIZE TIMER
DEFINT T

nc = 100                   'Number of consumers
nm = 4                     'Number of manufacturers / products
dimen = 3                  'Dimension of the system
follow = .01               'Magnitude of market leader(s) following
drift = 0                  'Magnitude of random displacements
explore = .1               'Magnitude that each manufacturer will probe
                           'to better satisfy its customers.
top = 2                    'Number of market leaders
d1 = 1: d2 = 2             'Initial dimensions to view
choice = 1                 'Uniform distribution
prefc = 1                  'Everyone has the same preferences

CLS

PRINT "Evolution of products (Ec 126) - by Julius Su"
PRINT "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~"
PRINT "(press RETURN to accept default choices)"
PRINT
PRINT "Number of consumers ( default ="; nc; ") ";
INPUT num: IF num > 0 THEN nc = num
PRINT "Number of products ( default ="; nm; ") ";
INPUT num: IF num > 0 THEN nm = num
PRINT "Number of market leaders ( default ="; top; ") ";
INPUT num: IF num > 0 THEN top = num
PRINT "Dimension of feature space ( default ="; dimen; ") ";
INPUT num: IF num > 0 THEN dimen = num
PRINT
PRINT "Parameters describing behavior of firms"
PRINT "---------------------------------------"
PRINT "1.  Maximum distance that a firm can sample ( default ="; explore; ") ";
INPUT num: IF num > 0 THEN explore = num
PRINT "2.  Tendency to follow the market leader(s) ( default ="; follow; ") ";
INPUT num: IF num > 0 THEN follow = num
PRINT "3.  Tendency to move randomly ( default ="; drift; ") ";
INPUT num: IF num > 0 THEN drift = num
PRINT
PRINT "Distribution of consumers in feature space"
PRINT "------------------------------------------"
PRINT "1.  Uniform distribution"
PRINT "2.  Distributed to edges"
PRINT "3.  Central distribution"
PRINT "4.  Spread around a cube"
PRINT
PRINT "Your choice ( default ="; choice; ") ";
INPUT num: IF num > 0 AND num < 5 THEN choice = num
PRINT
PRINT "Consumer preferences"
PRINT "--------------------"
PRINT "1.  Everyone the same"
PRINT "2.  Everyone different"
PRINT
PRINT "Your choice ( default ="; prefc; ") ";
INPUT num: IF num > 0 AND num < 3 THEN prefc = num

SCREEN 12
WINDOW (-1.2, -1.2)-(1.2, 1.2)

DIM c(nc, dimen), m(nm, dimen), mtrial(dimen)
DIM ctmp(dimen)
DIM score(nm), sort(nm), cust(nc + 3)
DIM pref(nc, dimen), preftmp(dimen)
DIM sn(361), cs(361)
DIM x(nc + 3), y(nc + 3), z(nc + 3)
DIM cx(nm), cy(nm), cz(nm)

FOR t = 0 TO 360
  sn(t) = SIN(.0087266463# * t)
  cs(t) = COS(.0087266463# * t)
NEXT t

FOR t = 1 TO nc
  SELECT CASE choice
  CASE 1:
    FOR d = 1 TO dimen
      c(t, d) = 2 * RND - 1
    NEXT d
  CASE 2:
    FOR d = 1 TO dimen
      c(t, d) = SGN(RND - .5) * SQR(RND)
    NEXT d
  CASE 3:
    FOR d = 1 TO dimen
      c(t, d) = SGN(RND - .5) * RND ^ 2
    NEXT d
  CASE 4:
    FOR d = 1 TO dimen
      c(t, d) = 1.5 * RND - .75
    NEXT d
    c(t, INT(RND * dimen) + 1) = .75 * SGN(RND - .5)
  END SELECT
  CIRCLE (c(t, d1), c(t, d2)), .03
NEXT t

IF prefc = 1 THEN
  FOR t = 1 TO nc
    FOR d = 1 TO dimen
      pref(t, d) = 1
    NEXT d
  NEXT t
ELSE
  FOR t = 1 TO nc
    FOR d = 1 TO dimen
      pref(t, d) = RND
    NEXT d
  NEXT t
END IF

FOR t = 1 TO nm
  FOR d = 1 TO dimen
    m(t, d) = .1 * (2 * RND - 1)
  NEXT d
  LINE (m(t, d1) - .01, m(t, d2) - .01)-(m(t, d1) + .01, m(t, d2) + .01), t, BF
NEXT t

DO

FOR t = 1 TO nm
  score(t) = 0
NEXT t

FOR t = 1 TO nc
  umax = -100
  FOR d = 1 TO dimen
    ctmp(d) = c(t, d)
    preftmp(d) = pref(t, d)
  NEXT d
  FOR m = 1 TO nm
    u = 0
    FOR d = 1 TO dimen
      dd = ctmp(d) - m(m, d)
      u = u - preftmp(d) * dd * dd
    NEXT d
    IF u > umax THEN umax = u: mmax = m
  NEXT m
  CIRCLE (c(t, d1), c(t, d2)), .03, mmax
  score(mmax) = score(mmax) + 1
  cust(t) = mmax
NEXT t

FOR t = 1 TO nm
  sort(t) = t
NEXT t

DO
  sf = 0
  FOR t = 1 TO nm - 1
    IF score(sort(t)) > score(sort(t + 1)) THEN
      SWAP sort(t), sort(t + 1)
      sf = 1
    END IF
  NEXT t
LOOP WHILE sf = 1

LINE (-1.1, -1.1)-(1.1, 1.1), sort(nm), B

a$ = INKEY$
IF a$ <> "" THEN
  SELECT CASE a$
  CASE "q":
    d1 = d1 - 1
    IF d1 < 1 THEN d1 = dimen
  CASE "[":
    d1 = d1 + 1
    IF d1 > dimen THEN d1 = 1
  CASE "w":
    d2 = d2 - 1
    IF d2 < 1 THEN d2 = dimen
  CASE "]":
    d2 = d2 + 1
    IF d2 > dimen THEN d2 = 1
  CASE "v":
    IF dimen > 2 THEN GOSUB visualize
  CASE CHR$(27):
    END
  CASE " ":
    DO UNTIL INKEY$ <> "": LOOP
  END SELECT
  CLS
  LOCATE 1, 1: PRINT d1, d2
END IF

FOR tt = nm TO 1 STEP -1

  t = sort(tt)
 
  u = 0
  FOR tp = 1 TO nc
    IF cust(tp) = t THEN
      FOR d = 1 TO dimen
        dd = c(tp, d) - m(t, d)
        u = u + pref(tp, d) * dd * dd
      NEXT d
    END IF
  NEXT tp

  FOR d = 1 TO dimen
    mtrial(d) = m(t, d) + explore * (RND - .5)
    IF mtrial(d) > 1 THEN mtrial(d) = 1
    IF mtrial(d) < -1 THEN mtrial(d) = -1
  NEXT d
 
  unew = 0
  FOR tp = 1 TO nc
    IF cust(tp) = t THEN
      FOR d = 1 TO dimen
        dd = c(tp, d) - mtrial(d)
        unew = unew + pref(tp, d) * dd * dd
      NEXT d
    END IF
  NEXT tp

  LINE (m(t, d1) - .01, m(t, d2) - .01)-(m(t, d1) + .01, m(t, d2) + .01), 0, BF
  IF unew < u THEN
    FOR d = 1 TO dimen
      m(t, d) = mtrial(d)
    NEXT d
  ELSE
    t2 = sort(INT(RND * top + (nm - top)) + 1)
    FOR d = 1 TO dimen
      m(t, d) = m(t, d) + follow * (m(t2, d) - m(t, d)) + drift * (RND - .5)
      IF m(t, d) > 1 THEN m(t, d) = 1
      IF m(t, d) < -1 THEN m(t, d) = -1
    NEXT d
  END IF
  LINE (m(t, d1) - .01, m(t, d2) - .01)-(m(t, d1) + .01, m(t, d2) + .01), t, BF

NEXT tt

LOOP

visualize:

CLS
SCREEN 12
WINDOW (-1.5, -1.5)-(1.5, 1.5)

d1 = 1: d2 = 2: d3 = 3

FOR t = 1 TO nc
  x(t) = c(t, d1)
  y(t) = c(t, d2)
  z(t) = c(t, d3)
NEXT t

FOR t = 1 TO nm
  cx(t) = m(t, d1)
  cy(t) = m(t, d2)
  cz(t) = m(t, d3)
NEXT t

x(nc + 1) = 1: x(nc + 2) = 0: x(nc + 3) = 0
y(nc + 1) = 0: y(nc + 2) = 1: y(nc + 3) = 0
z(nc + 1) = 0: z(nc + 2) = 0: z(nc + 3) = 1
cust(nc + 1) = d1: cust(nc + 2) = d2: cust(nc + 3) = d3


thetax = 0
thetay = 0
thetaz = 0
freeze = 0
cthx = 1: cthy = 1: cthz = 1
sthx = 0: sthy = 0: sthz = 0
axisflag = 0
scrnmode = 12

DO
  a$ = INKEY$
  IF a$ <> "" THEN
    SELECT CASE a$
    CASE "1":
      thetax = thetax - 1
    CASE "2":
      IF thetax > 0 THEN thetax = thetax - 1
      IF thetax < 0 THEN thetax = thetax + 1
    CASE "3":
      thetax = thetax + 1
    CASE "4":
      thetay = thetay - 1
    CASE "5":
      IF thetay > 0 THEN thetay = thetay - 1
      IF thetay < 0 THEN thetay = thetay + 1
    CASE "6":
      thetay = thetay + 1
    CASE "7":
      thetaz = thetaz - 1
    CASE "8":
      IF thetaz > 0 THEN thetaz = thetaz - 1
      IF thetaz < 0 THEN thetaz = thetaz + 1
    CASE "9":
      thetaz = thetaz + 1
    CASE "0":
      thetax = 0
      thetay = 0
      thetaz = 0
    CASE "q":
      d1 = d1 - 1
      IF d1 < 1 THEN d1 = dimen
      GOSUB update
    CASE "[":
      d1 = d1 + 1
      IF d1 > dimen THEN d1 = 1
      GOSUB update
    CASE "w":
      d2 = d2 - 1
      IF d2 < 1 THEN d2 = dimen
      GOSUB update
    CASE "]":
      d2 = d2 + 1
      IF d2 > dimen THEN d2 = 1
      GOSUB update
    CASE "e":
      d3 = d3 - 1
      IF d3 < 1 THEN d3 = dimen
      GOSUB update
    CASE "\":
      d3 = d3 + 1
      IF d3 > dimen THEN d3 = 1
      GOSUB update
    CASE "a":
      IF axisflag = 1 THEN axisflag = 0: CLS  ELSE axisflag = 1
      un = 1
    CASE "s":
      IF manuflag = 1 THEN manuflag = 0: CLS  ELSE manuflag = 1
      un = 1
    CASE "v":
      SCREEN 12
      WINDOW (-1.2, -1.2)-(1.2, 1.2)
      RETURN
    CASE "d":
      IF scrnmode = 13 THEN scrnmode = 12 ELSE scrnmode = 13
      SCREEN scrnmode
      WINDOW (-1.5, -1.5)-(1.5, 1.5)
      un = 1
    CASE CHR$(27):
      END
    END SELECT
   
    IF thetax = 0 AND thetay = 0 AND thetaz = 0 AND un = 0 THEN freeze = 1 ELSE freeze = 0
    un = 0
   
    IF thetax < 0 THEN
      cthx = cs(-thetax)
      sthx = -sn(-thetax)
    ELSE
      cthx = cs(thetax)
      sthx = sn(thetax)
    END IF
    IF thetay < 0 THEN
      cthy = cs(-thetay)
      sthy = -sn(-thetay)
    ELSE
      cthy = cs(thetay)
      sthy = sn(thetay)
    END IF
    IF thetaz < 0 THEN
      cthz = cs(-thetaz)
      sthz = -sn(-thetaz)
    ELSE
      cthz = cs(thetaz)
      sthz = sn(thetaz)
    END IF
  END IF

  IF freeze = 0 THEN
    FOR t = 1 TO nc
      x = x(t): y = y(t): z = z(t)
      y1 = y * cthx + z * sthx
      z1 = z * cthx - y * sthx
      z2 = z1 * cthy + x * sthy
      x1 = x * cthy - z1 * sthy
      y2 = y1 * cthz + x1 * sthz
      x2 = x1 * cthz - y1 * sthz
      PRESET (x(t), y(t))
      PSET (x2, y2), cust(t)
      x(t) = x2: y(t) = y2: z(t) = z2
    NEXT t
    IF axisflag = 1 THEN
      FOR t = nc + 1 TO nc + 3
        x = x(t): y = y(t): z = z(t)
        y1 = y * cthx + z * sthx
        z1 = z * cthx - y * sthx
        z2 = z1 * cthy + x * sthy
        x1 = x * cthy - z1 * sthy
        y2 = y1 * cthz + x1 * sthz
        x2 = x1 * cthz - y1 * sthz
        LINE (0, 0)-(x(t), y(t)), 0
        LINE (0, 0)-(x2, y2), cust(t)
        x(t) = x2: y(t) = y2: z(t) = z2
      NEXT t
    END IF
    IF manuflag = 1 THEN
      FOR t = 1 TO nm
        x = cx(t): y = cy(t): z = cz(t)
        y1 = y * cthx + z * sthx
        z1 = z * cthx - y * sthx
        z2 = z1 * cthy + x * sthy
        x1 = x * cthy - z1 * sthy
        y2 = y1 * cthz + x1 * sthz
        x2 = x1 * cthz - y1 * sthz
        LINE (cx(t) - .01, cy(t) - .01)-(cx(t) + .01, cy(t) + .01), 0, B
        LINE (x2 - .01, y2 - .01)-(x2 + .01, y2 + .01), t, B
        cx(t) = x2: cy(t) = y2: cz(t) = z2
      NEXT t
    END IF
  END IF

LOOP

update:

FOR t = 1 TO nc
  x(t) = c(t, d1)
  y(t) = c(t, d2)
  z(t) = c(t, d3)
NEXT t

FOR t = 1 TO nm
  cx(t) = m(t, d1)
  cy(t) = m(t, d2)
  cz(t) = m(t, d3)
NEXT t

cust(nc + 1) = d1: cust(nc + 2) = d2: cust(nc + 3) = d3

CLS
un = 1
LOCATE 1, 1
PRINT d1; d2; d3

RETURN