! Illustrating the effect of forgetting (delayed) test on transfer to ! new stimuli from an exemplar-based memory system PROGRAM Minerva2 use number_generators implicit none integer, parameter :: N_Feat = 13, & ! # of features in each field N_Cats = 3, & ! # of categories Exp = 3, & ! # power of similarity metric N_Items = 18, & ! total # of exemplars to be learned High_Distort = 4, & ! # of features to flip in high distortion Low_Distort = 2, & ! # of features to flip in low distortion SUBS = 300 ! # of subjects (replications) to simulate real :: F = 0.0 ! probability of forgettig a feature real :: Memory(N_Feat*2, N_Items), & Trace(N_Feat*2, N_Items), & Prototype(N_Feat, N_Cats), & Label(N_Feat, N_Cats), & Probe(N_Feat), & Echo(N_Feat), & Activation, & Correct(4) integer :: i, j, idum, sample, time, Cat=3 !++++++++BEGIN SIMULATION++++++++++++++++++++++++++++++++++++++ call RandSeed ! initializing the r-num generator call Init_Output ! initializing files for time-series output DO time = 1, 9999 ! How many time points? F = F +0.0001 ! At each time point, p(forget) increases by this amount Correct = 0 DO sample = 1, SUBS ! For each time point, simulate this many subjects (new stimuli and memories) ! Generating Prototypes and Labels for N_Cats categories: do i = 1, N_Cats Prototype(:,i) = Random_Vector(N_Feat) Label(:,i) = Random_Vector(N_Feat) enddo Memory = 0 ! Creating memory with high-level distortions (n=4 flipped elements) ! We'll do 3, 6, and 9 distortions of Cats 1, 2, 3; identical to Hintzman (1986) p. 415 do i = 1, 3 Memory(1:N_Feat,i) = Distort(Prototype(:,1), N_Feat, High_Distort) ! making 3 distortions of Cat 1 prototype Memory(N_Feat+1:N_Feat*2,i) = Label(1:N_Feat,1) ! and labelling them "Cat 1" enddo do i = 4, 9 Memory(1:N_Feat,i) = Distort(Prototype(:,2), N_Feat, High_Distort) ! making 6 distortions of Cat 2 prototype Memory(N_Feat+1:N_Feat*2,i) = Label(1:N_Feat,2) ! and labelling them "Cat 2" enddo do i = 10, N_Items Memory(1:N_Feat,i) = Distort(Prototype(:,3), N_Feat, High_Distort) ! making 9 distortions of Cat 3 prototype Memory(N_Feat+1:N_Feat*2,i) = Label(1:N_Feat,3) ! and labelling them "Cat 3" enddo call Forget(F,Memory) probe = Distort(Prototype(:,Cat), N_Feat, Low_Distort) ! New low-distortion of Cat C Correct(1) = Correct(1) + Classify(Probe, Label, Memory, Cat) ! Classify the probe(Cat C) into the 3 categories and return 1=correct, 0=incorrect probe = Distort(Prototype(:,Cat), N_Feat, High_Distort) ! New high-distortion of Cat C Correct(2) = Correct(2) + Classify(Probe, Label, Memory, Cat) ! Classify the probe(Cat C) into the 3 categories and return 1=correct, 0=incorrect probe = Memory(1:N_Feat,13) ! An old (learned) exemplar Correct(3) = Correct(3) + Classify(Probe, Label, Memory, Cat) ! Classify the probe(Cat C) into the 3 categories and return 1=correct, 0=incorrect probe = Prototype(:,Cat) ! Probe with the category prototype (never learned) Correct(4) = Correct(4) + Classify(Probe, Label, Memory, Cat) ENDDO ! sample do i = 1, 4 write(i,*) time, ' ', Correct(i)/SUBS enddo ENDDO ! time close(1) close(2) close(3) close(4) !++++++++END SIMULATION++++++++++++++++++++++++++++++++++++++++ CONTAINS ! Subroutines follow this statement !================================================================= !**************************************************************** function Random_Vector(D) integer :: D, i real :: Random_Vector(D), x do i = 1, D x = ran3(idum) ! random number 0 <= x <= 1 from uniform if (x >= 0.5) then Random_Vector(i) = 1 else Random_Vector(i) = -1 endif enddo end function Random_Vector !**************************************************************** !**************************************************************** function Distort(Vector, D, n_flip) integer :: i, j, D, n_flip, List(n_flip) real :: Vector(D), Distort(D), x List = Rand_List(n_flip, D) ! get a list of n_flip random numbers from 1..D Distort = Vector do i = 1, n_flip Distort(List(i)) = -1.0 * Vector(List(i)) ! flipping bit enddo end function !**************************************************************** !***************************************************************** subroutine Forget(F, Matrix) integer :: i, j real :: F, Matrix(N_Feat*2,N_Items), x do i = 1, N_Items do j = 1, N_Feat*2 x = ran3(idum) if (x < F) Matrix(j,i) = 0 ! Forget the feature with a probability of F enddo enddo end subroutine Forget !***************************************************************** !***************************************************************** function Classify(Probe, Label, Memory, Correct_Label) integer :: i, j, Correct_Label, Assigned_Label, Classify, loc real :: Probe(N_Feat), Label(N_Feat,N_Cats), Memory(N_Feat*2,N_Items), & Similarity, Max Classify = 0 echo = 0 Max = 0.0 do i = 1, N_Items Activation = Vector_Cosine(Probe, Memory(1:N_Feat,i), N_Feat) ** Exp Echo = Echo + (Memory(N_Feat+1:N_Feat*2,i)*Activation) enddo do i = 1, N_Cats Similarity = Vector_Cosine(Echo, Label(:,i), N_Feat) if (Similarity > Max) then Max = Similarity loc = i endif enddo Assigned_Label = loc if (Correct_Label == Assigned_Label) Classify = 1 ! if we pick the right label, give us a point end function !***************************************************************** !***************************************************************** subroutine Init_Output open(unit=1, file='new-lo', status='replace') open(unit=2, file='new-hi', status='replace') open(unit=3, file='old', status='replace') open(unit=4, file='proto', status='replace') end subroutine Init_Output !***************************************************************** !************************************************ ! SOME MATRIX ALGEBRA TOOLS: ! !************************************************ !**************************************************************** function Vector_Length (Vector, n) integer :: i, n real :: Vector_Length, Vector(n), SS SS = 0.0 SS = dot_product(Vector, Vector) Vector_Length = sqrt(SS) end function Vector_Length !**************************************************************** !**************************************************************** subroutine Normalize (Vector_In, n) integer :: i, n real :: Vector_In(n), Vect_Length, Test_Val Test_Val = dot_product(Vector_In, Vector_In) if (Test_Val == 0.0) then return endif Vect_Length = 0.0 Vect_Length = Vector_Length(Vector_In, n) Vector_In = Vector_In / Vect_Length end subroutine Normalize !**************************************************************** !**************************************************************** function Vector_Cosine (Vector1, Vector2, n) real :: Vector1(n), Vector2(n) real :: Vector_Cosine integer :: n, i call Normalize(Vector1, n) call Normalize(Vector2, n) Vector_Cosine = dot_product(Vector1, Vector2) end function Vector_Cosine !**************************************************************** !**************************************************************** function Correlate (x, y, n) real :: Correlate, x(n), y(n), & yt, xt, t, syy, sxy, sxx, df, ay, ax integer :: n, j real, parameter :: tiny = 1.0e-20 ax = 0.0 ay = 0.0 do j = 1, n ax = ax + x(j) ay = ay + y(j) end do ax = ax /n ay = ay /n sxx = 0.0 syy = 0.0 sxy = 0.0 do j = 1, n xt = x(j) - ax yt = y(j) - ay sxx = sxx + xt**2 syy = syy + yt**2 sxy = sxy + xt * yt end do Correlate = sxy/sqrt(sxx*syy) end function Correlate !**************************************************************** END PROGRAM Minerva2