########################################
#
#             crypto.mpl
#      basic cryptography procedures
#
#David Joyner, wdj@nadn.navy.mil, 11-98
########################################


### WARNING: semantics of type `string` have changed
### from V4 to V5
seg:=proc(s::string,m::integer,n::integer)
 #returns the substring of s
 #from positions m through n
# this can be combined with MAPLE's
# procedure SearchText
 local s0;
 if m>n then ERROR(`arg[2] must be less than arg[3]`);
 fi;
 s0:=substring(s,m..n);
 RETURN(s0);
end:

alphabet:=["A","B","C","D","E","F","G","H","I","J","K","L","M","N","O","P","Q","R","S","T","U","V","W","X","Y","Z","a","b","c","d","e","f","g","h","i","j","k","l","m","n","o","p","q","r","s","t","u","v","w","x","y","z"," ",",",".","?","!"]:

`crypt/alphabet`:="abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"."``1234567890-=~!@#$£%^&*()_+"." ,./<>?;':[]{}|":

alphabet0:=["a","b","c","d","e","f","g","h","i","j","k","l","m","n","o","p","q","r","s","t","u","v","w","x","y","z","A","B","C","D","E","F","G","H","I","J","K","L","M","N","O","P","Q","R","S","T","U","V","W","X","Y","Z","`","1","2","3","4","5","6","7","8","9","0","-","=","~","!","@","#","$","£","%","^","&","*","(",")","_","+",".","/","<",">","?",";","'",":","[","]","{","}","|"," ",","]:

### WARNING: semantics of type `string` have changed
### from V4 to V5
locate:=proc(s1::string,s2::string)
 #RETURNS list of positions where
 #s1 occurs in s2
 #case sensitive
 local i,l1,l2,L;
 L:=[]:
 l1:=length(s1);
 l2:=length(s2);
 for i from 1 to l2-l1+1 do
  if searchtext(s1,substring(s2,i..(i+l1-1)))<>0 then
    L:=[op(L),i];
  fi;
 od: RETURN(L);
end:

### WARNING: semantics of type `string` have changed
### from V4 to V5
Locate:=proc(s1::string,s2::string)
 #RETURNS list of positions where
 #s1 occurs in s2
 #case sensitive
 local i,l1,l2,L;
 L:=[]:
 l1:=length(s1);
 l2:=length(s2);
 for i from 1 to l2-l1+1 do
  if s1=substring(s2,i..(i+l1-1)) then
    L:=[op(L),i];
  fi;
 od: RETURN(L);
end:

statistics:=proc(mytext::string)
#returns the ranked list of most common
#characters and their percentages of occurrance
 local x,L;
 global alphabet;
 L:=[];
 for x in alphabet do
 L:=[op(L),[x,100*evalf(nops(Locate(x,mytext))/length(mytext))]]; 
 od:
 RETURN(sort(L,occur_order));
end:

prob_occur:=proc(s::string)
#returns the probability that a letter x occurs in a typical 
#English text
 local p,P,i,alphabet1;
 alphabet1:=["a","b","c","d","e","f","g","h","i","j","k","l","m","n","o","p","q","r","s","t","u","v","w","x","y","z"];
 P:=[.082,.015,.028,.043,.127,.022,.02,.061,.07,.002,.008,.04,.024,.067,.075,.019,.001,.06,.063,.091,.028,.01,.023,.001,.02,.001];
 p:="Not a letter.";
 for i from 1 to 26 do
  if s=alphabet1[i] then p:=P[i]; fi;
 od;
 RETURN(p);
end:

occur_order:=proc(a,b)
 #assumes a,b are pairs of the
 # form a=[c_a,f_a], c_a a character, 
 # f_a a real number,
 #returns true if f_a<f_b
  local n,i,j;
  if a[2]<b[2] then RETURN(`false`); fi;
  RETURN(`true`);
end:

order2:=proc(L1::list,L2::list)
 local x,y;
 x:=L1[2];y:=L2[2];
 RETURN(evalb(x>y));
end:

Prob_Occur:=proc()
#returns list of occurances, sorted to likeliness
local S1,S0,s,alphabet1;
alphabet1:=["a","b","c","d","e","f","g","h","i","j","k","l","m","n","o","p","q","r","s","t","u","v","w","x","y","z"];
S0:=[seq([s,100*prob_occur(s)],s=alphabet1)]:
S1:=sort(S0,order2);
RETURN(S1);
end:

replace:=proc(s::string,x,w::string)
 local i,j,w1,s1,N,M,L;
 #replaces each occurence of s in w with x
 N:=length(w);
 M:=length(s);
 L:=locate(s,w);
 w1:="";
 for i from 1 to N do
 if member(i,L) then w1:=cat(w1,x);
   else w1:=cat(w1,substring(w,i));
  fi;
 od;
 RETURN(w1);
end:

string_to_list := proc(st::string) 
 local ll, nn, ss, ii,Lss,i;
 global `crypt/alphabet`; 
 ll := length(st);
 if ll = 0 then RETURN(0) fi; 
 nn := [];
 for ii to ll do 
  ss := SearchText(substring(st,ii..ii),`crypt/alphabet`);
  if not type(ss, numeric) or ss = 0 then
   ERROR(`the letter `.(substring(st, ii .. ii))
 .` is not in the alphabet`)
  fi;
  Lss:=convert(ss,base,2); 
  nn := [op(nn),op(Lss),seq(0,i=1..(20-nops(Lss)))]; 
 od;
 RETURN(nn); 
end:

list_to_string := proc(L0::list)
 local str,i,j,L,l,s,ss, mm, ll, pp, ii,N, ans;
 str:="";
 N:=floor(nops(L0)/20);
 for i from 1 to N do
  for j from 1 to 20 do
   l[j]:=L0[j+20*(i-1)];
  od;
 L:=[seq(l[j],j=1..20)];
  for s in alphabet0 do
   if string_to_list(s)=L then
    str:=cat(str,s);
    BREAK;
   fi;
 od;
 od;
 RETURN(str);
end:

random_list:=proc(N0::integer,seed0::integer)
 local L,i;
 global _seed;
 _seed:=seed0;
 L:=[];
 for i from 1 to N0 do
  L:=[op(L),rand() mod 2];
 od;
 RETURN(L);
end:

encrypt:=proc(S0::string,seed0::integer)
#stream encryption
 local M0,M1,z0,z1,e0,e1,N,randS;
 M0:=string_to_list(S0);
 N:=nops(M0);
 randS:=random_list(N,seed0);
 z0:=randS();
 e0:=`mod`(M0+z0,2);
 RETURN(e0);
end:

decrypt:=proc(L0::list,seed0::integer)
 local M0,M1,z0,z1,e0,e1,N,randS,i;
 N:=nops(L0);
 randS:=random_list(N,seed0);
 z0:=randS();
 e0:=`mod`(L0+z0,2);
 e1:=add(2^i*e0[N+1-i],i=1..N);
 M0:=list_to_string(e0);
 RETURN(M0);
end: