API tools faq
paste
View difference between Paste ID: 3aGZr0nX and cxLuGC3A
SHOW: | | - or go back to the newest paste.
1-
%%
1+
2-
%%  Authors:

2+
3-
%%    Christian Schulte <schulte@imit.kth.se>

3+
4-
%%      LECS, IMIT, KTH - Royal Institute of Technology

4+
   encontrar: Encontrar

5-
%%      Stockholm, Sweden

5+
   aplicarMovimientos:AplicarMovimientos  

6-
%%

6+
   aplicarMovimiento:AplicarMovimiento

7-
%%  Copyright:

7+
8-
%%    Christian Schulte, 2002

8+
% Estructura de los datos estado(principal:P uno:U dos:D)

9-
%%

9+
fun {AplicarMovimiento S M}

10-
%%  Last change:

10+
   case S of estado(principal:P uno:U dos:D)then

11-
%%    $Date: 2002/07/24 14:23:31 $ by $Author: schulte $

11+
12-
%%    $Revision: 1.5 $

12+
      local Lp PrimerosU UltimosU PrimerosP UltimosP PrimerosD UltimosD Subl in

13-
%%

13+
	% {Browse  P}

14-
%%  Purpose:

14+
15-
%%    Datalogi II, Lab A, Visualizing the shunting station

15+
	 Lp={Length P}

16-
%%

16+
17
      %Si el movimiento se hace en la linea uno

18
      case M of uno(N) then	 

19
	 Subl=Lp-N

20-
import

20+
21-
   Tk

21+
	 {ParticionN U N PrimerosU UltimosU}

22
	 {ParticionN P Subl PrimerosP UltimosP}

23-
   Visualizar

23+
24-
define

24+
    	     if(N<0)

25-
   proc {Visualizar States}

25+
	         then  estado(principal:{Append S.principal PrimerosU} uno:UltimosU dos:D)

26-
      %% Dimensions for graphics

26+
	         elseif (N==0)then estado(principal:P uno:U dos:D) 

27-
      N  = {Max ({Length States.1.principal} +

27+
	         else  estado(principal:PrimerosP  uno:{Append UltimosP U} dos:D)

28-
		 {Length States.1.uno} +

28+
		     end

29-
		 {Length States.1.dos}) 4}

29+
    

30-
           % Maximal number of wagons per track

30+
       %Si el movimiento se hace en la linea dos

31-
      W  = 55 % Width of a wagon

31+
       [] dos(N) then

32-
      %%   WD = 5  % Space between wagons

32+
       Subl=Lp-N

33-
      H  = 45 % Height of a wagon

33+
       {ParticionN D N PrimerosD UltimosD} 

34-
      %%   HD = 5  % Space between wagon and track border

34+
       {ParticionN P Subl PrimerosP UltimosP}

35-
      B  = 25 % Border around tracks

35+
	      if(N<0)

36-
      %% Window structure

36+
          then estado(principal:{Append P UltimosD} uno:U dos:UltimosD)

37-
      T    = {New Tk.toplevel tkInit(title:'Visualizador de maniobras')}

37+
          elseif (N==0)then estado(principal:P uno:U dos:D) 

38-
      F    = {New Tk.frame tkInit(parent:T)}

38+
	      else  estado(principal:PrimerosP uno:U dos:{Append UltimosP D})

39-
      %% Buttons with logic

39+
	      end

40-
      Pos  = {NewCell 1} % Stores the state currently displayed

40+
        end

41-
      Prev = {New Tk.button tkInit(parent: F

41+
     end

42-
				   text:   'Ant.'

42+
    end

43-
				   action:

43+
end

44-
				      proc {$}

44+
45-
					 I I1={Exchange Pos I}

45+
%Aplicar una secuencia de movimientos sobre un estado inicial

46-
				      in

46+
fun {AplicarMovimientos S Ms}

47-
					 if I==2 then

47+
    case S of estado(principal:P uno:U dos:D)

48-
					    {Prev tk(configure state:disabled)}

48+
    then

49-
					 end

49+
		 case Ms 

50-
					 I1=I-1

50+
    	 of nil then S

51-
					 {Next tk(configure state:normal)}

51+
    	 [] H|T then {AplicarMovimientos {AplicarMovimiento S H} T} 

52-
					 {Show {Nth States I1}}

52+
		 end

53-
				      end

53+
54-
				   state: disabled

54+
end

55-
				  )}

55+
56-
      Next = {New Tk.button tkInit(parent: F

56+
%Procedimiento para particionar la lista en 2 sublistas de n y longitud total - n elementos, respectivamente

57-
				text:   'Sig.'

57+
proc {ParticionN L N ?H ?T}

58-
				   action:

58+
     if (N>0) then

59-
				      proc {$}

59+
	case L of nil then skip

60-
					 I I1={Exchange Pos I}

60+
	[] Ca|Co then {ParticionN Co (N-1) {Append H Ca} T}

61-
				      in

61+
	       end

62-
					 if I+1=={Length States} then

62+
     end

63-
					    {Next tk(configure state:disabled)}

63+
end

64-
					 end

64+
%{Browse {ParticionN [a b c d e] 3 }}

65-
					 I1=I+1

65+
66-
					 {Prev tk(configure state:normal)}

66+
67-
					 {Show {Nth States I1}}

67+
68-
				      end

68+
%Funcion para invertir una lista

69-
				   state: if {Length States}==1 then

69+
fun {Invertir L}

70-
					     disabled

70+
    case L of nil then nil

71-
					  else

71+
    [] H|T  then {Append {Invertir T} [H]}

72-
					     normal

72+
    end

73-
					  end

73+
end

74-
				   

74+
75-
				  )}

75+
{Browse {AplicarMovimiento estado(principal:[a b c d e] uno:[g] dos:[f]) uno(2)}}

76-
      %% Important coordinates

76+
77-
      Y0  = B+0

77+
78-
      Y1  = B+H

78+
%Funcion para encontrar el total de vagones que tiene un tren

79-
      Y2  = B+2*H

79+
fun {NumeroVagones S }

80-
      Y25 = Y2 + H div 2

80+
    case S of estado(principal:P uno:U dos:D)then

81-
      Y3  = B+3*H

81+
    	  local L L1 L2

82-
      Y4  = B+4*H

82+
     	   in L={List.length P} L1={List.length U} L2={List.length D}

83-
      Y5  = B+5*H

83+
     	   L+L1+L2

84-
      X0  = B+0

84+
85-
      X1  = B+N*W

85+
    end

86-
      X2  = X1 + H div 2 + H div 4

86+
end

87-
      X3  = X1 + 2*H+10

87+
88-
      X31 = X1 + 2*H

88+
%Determinar si 2 trenes tienen el mismo numero de vagones

89-
      X4  = X3 + N*W

89+
fun {IgualdadVagones Xs Ys}

90
    ({NumeroVagones Xs}=={NumeroVagones Ys})

91-
      %% The drawing area

91+
end

92-
      C = {New Tk.canvas tkInit(parent: T

92+
93-
				bg:     wheat

93+
%Comparar longitud de las listas

94-
				width:  X4+B

94+
fun {CompararItems L1 L2}

95-
				height: 2*B+5*H)}

95+
    case L1 of

96-
      /*

96+
    nil then true

97-
      %% Routines for drawing a single wagon

97+
    [] H|T then

98-
      proc {Wagon X Y T}

98+
       if(H==L2.1) then {CompararItems T L2.2}

99-
	 {C tk(create rectangle X+WD Y+HD X+W-WD Y+H-HD

99+
       else false

100-
	       fill:grey)}

100+
       end

101-
	 {C tk(create text X+W div 2 Y + H div 2 text:T)}

101+
    end

102
end

103-
      */

103+
104-
      %% Routines for drawing a single wagon

104+
105-
      proc {Wagon X Y T}

105+
fun {CompararListas L1 L2}

106-
	 N Engine

106+
     if {List.length L1}=={List.length L2}	

107-
      in

107+
     then {CompararItems L1 L2}

108-
	 N = ({Atom.toString T}.1 - 96) mod 11

108+
     else false

109-
	 Engine = {New Tk.image tkInit(type:photo file:'images/'#N#'.gif')}

109+
     end

110-
	 {C tk(create image X+W div 2 Y+H div 2 image:Engine)}

110+
end

111-
	 {C tk(create text X+W div 2 Y anchor:n text:T)}

111+
112
113
114-
      %% Display a state

114+
% Detectar vagones repetidos al interior de un tren

115-
      proc {Show State}

115+
fun {DetectarRepetidos Ls Ant}      

116
    if (Ls==nil) then false

117-
	 %% Display each track

117+
    elseif (Ant==Ls.1) then true

118-
	 proc {Main Ws}

118+
    else {Or false {DetectarRepetidos Ls.2 Ls.1}}

119-
	    {List.forAllInd {Reverse Ws}

119+
    end

120-
	     proc {$ I T}

120+
end

121-
		{Wagon X1-I*W Y2 T}

121+
122-
	     end}

122+
123
%Devolver una lista con los estados intermedios que se generan, tras aplicarle una serie de movimientos sobre una estado inicial

124
fun {EstadosIntermedios S Ms}

125-
	 proc {One Ws}

125+
case S of estado(principal:P uno:U dos:D)

126-
	    {List.forAllInd Ws

126+
	then 

127-
	     proc {$ I T}

127+
		 case Ms of

128-
		{Wagon X3+(I-1)*W Y0 T}

128+
		 nil then S

129-
	     end}

129+
		 [] H|T then

130
			   local Actual 

131
			   in Actual= {AplicarMovimiento S H}

132-
	 proc {Two Ws}

132+
			   Actual|{EstadosIntermedios Actual T}

133-
	    {List.forAllInd Ws

133+
			   end

134-
	     proc {$ I T}

134+
	     end

135-
		{Wagon X3+(I-1)*W Y4 T}

135+
    end

136-
	     end}

136+
end

137
138
139-
      in

139+
%SubListas coincidentes

140-
	 %% Reset drawing

140+
fun {SublistasCoincidentes Xs Ys}

141-
	 {C tk(delete all)}

141+
   case Xs of

142-
	 %% Create tracks

142+
      nil then nil

143-
	 {C tk(create polygon

143+
   else {LongitudCoincidencia Xs Ys 0}|{SublistasCoincidentes Xs.2 Ys.2}

144-
	       X0 Y2 X0 Y3 X1 Y3  X31 Y5 X4 Y5

144+
145-
	       X4 Y4-1 X3 Y4-1 X2 Y25 X3 Y1 X4 Y1

145+
end

146-
	       X4 Y0 X31 Y0 X1 Y2  X0 Y2

146+
%Esto se puede optimizar tantisimo

147-
	       fill:    white

147+
148-
	       outline: black)}

148+
149-
	 %% Create railroads

149+
150-
	 %%{C tk(create line  X0 Y2+25 X1 Y2+25 width:2)}

150+
%Longitud de las sublista coincidente

151-
	 {C tk(create line  X0 Y3-4 X1+3 Y3-4 width:2)}

151+
fun {LongitudCoincidencia Xs Ys Cont}

152-
	 {C tk(create line  X1+2 Y3-4 X31+2 Y5-4 width:2)}

152+
   case Xs of

153-
	 {C tk(create line  X31+2 Y5-4 X4 Y5-4 width:2)}

153+
      nil then cont

154-
	 {C tk(create line  X1+2 Y3-4 X31+2 Y1-4 width:2)}

154+
      [] H|T then

155-
	 {C tk(create line  X31+2 Y1-4 X4 Y1-4 width:2)}

155+
      case Ys of

156
		 H1|T1 then

157-
	 %% Label tracks

157+
		 if(H==H1)then {LongitudCoincidencia T T1 (Cont + 1)}

158-
	 {C tk(create text X0+10 Y2-10 anchor:w text:'principal')}

158+
		 else cont

159-
	 {C tk(create text X3+10 Y0-10 anchor:w text:'uno')}

159+
		  end

160-
	 {C tk(create text X3+10 Y4-10 anchor:w text:'dos')}

160+
161-
	 %% Draw trains

161+
end

162-
	 {Main State.principal}

162+
end

163-
	 {One  State.uno}

163+
164-
	 {Two  State.dos}

164+
%Devuelve la posicion del elemento e al interior de la lista l

165
   fun {EncontrarPosicion E L Pos}

166
      case L of

167-
   in

167+
	 H|T then if(H==E) then pos

168-
      {Tk.batch [grid(F row:0 column:0)

168+
	 else {EncontrarPosicion e T (Pos + 1)}

169-
		 pack(Prev Next side:left padx:5#m pady:2#m)

169+
170-
		 grid(C row:1 column:0)]}

170+
171-
      {Show States.1}

171+
172
	 

173-
   %%{Visualize [estado(principal:[a b] uno:[a] dos:[b]) estado(principal:[b] uno:[a] dos:[b]) estado(principal:[c b] uno:[d] dos:[a b])]}

173+
174
%Funcion que retorna la lista de movimientos para llevar el estado Xs al estado Ys

175
fun {Encontrar Xs Ys}

176
177
   %Caso trivial

178
   if(Xs==Ys)then uno(0)|nil

179
   else

180
      %Validar que el tamaño de los trenes sea el mismo

181
      if({IgualdadVagones Xs Ys})

182
      then

183
	 %Validar que no hallan vagones repetidos al interior de ningun tren

184
	 if({Not{Or {DetectarRepetidos Xs nil}{DetectarRepetidos Ys nil}}})

185
	   then

186
	      %Validar que los vagones de los trenes sean permutaciones sobre el mismo conjunto

187
	    if({CompararListas {Sort Xs '<'}{Sort Ys '<'}})

188
	    then

189
	       local ListaCoincidencias in

190
		  ListaCoincidencias={SublistasCoincidentes Xs Ys}

191
		  {EncontrarAux Xs Ys ListaCoincidencias}

192
		  end

193
	       end

194
	    end

195
      end

196
   end

197
end

198
199
 fun {EncontrarAux Xs Ys Cs}

200
    local L NCoincidencias NEquivocados Siguiente Antes Despues in

201
       L={Length Xs}

202
       NCoincidencias=Cs.1

203
       %Caso 1:Sublistas iniciales coincidentes

204
       if(NCoincidencias>0)

205
       then NEquivocados=L- NCoincidencias

206
       {EncontrarAux {Ultimos Xs NEquivocados}{Ultimos Ys NEquivocados}{Ultimos Cs NEquivocados}}

207
208
       %Caso 2:Sublistas inicialmente diferentes

209
	  else

210
	  Siguiente={EncontrarPosicion Ys.1 Xs 0}

211
	  Despues=   L-Siguiente+1

212
	  Antes=     L-Despues

213
	  %Movemos el bloque de tamaño Longitud de la lista-Siguiente +1

214
	  [dos(Despues) uno(Antes) dos(~1) uno(~Antes) dos(~(Despues-1))] | {EncontrarAux Xs.2 Ys.2 Cs.2} 

215
   end    

216
end

217
end

218
219
end
        

    


            


                                


        

            



                
    

        Public Pastes
    

    
            

    

                    

        

    





    


    
    
    
    
    
    
    
    




    


    



                

            We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.             OK, I Understand
        

    
                

            

                
                    
                
            

            

                Not a member of Pastebin yet?

                Sign Up, it unlocks many cool features!