Le Programmateur

Le serveur d'un chat en C

Fr@nZ — Sun, 29 Nov 2009 17:02:00 +0100

Je présente ici le serveur d'un logiciel de chat en C. Il utilise biensûr les sockets et nécessite le client décrit dans cet article pour fonctionner.

#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <sys/types.h>
#include <sys/socket.h>
#include <netinet/in.h>
#include <pthread.h> 
 
#define NPORT 10000
#define CONNEXION 0
#define MESSAGE 1
#define DISCONNECT 2
 
char * surnom[10];
int sockService[10];
int occupe[10];
struct sockaddr_in client_adr[10];
socklen_t ** client_len;
struct sockaddr_in serveur_adr;
pthread_t  * thread_reception;    
int lastFreePlace;
 
int sockListen;

//~ Cette fonction est appelée dans le main et gérée par un thread afin de répondres aux clients demandeurs d'un fichier
static void * attendreReceptionMessage(void * param){
	//~ int * p_place = (int *)param;
	//~ int place = *p_place;
	int place = lastFreePlace;
	int rval;
	char buf[1024];
	char * firstLetterFromRequest = (char*)malloc(sizeof(char)*2);
	char * requestToSend = (char*)malloc(sizeof(char)*4096);
 
	int i;
	while(1){
		i=0;
		bzero(buf,sizeof(buf));
		if( rval = read (sockService[place], buf, 1024) < 0 ){
			perror("read");
		}
 
		//prendre premier caractère de buf
		firstLetterFromRequest[0]=buf[0];
		firstLetterFromRequest[1]='\0';
		//~ printf("Buffer :%d\n",atoi(firstLetterFromRequest));
		switch(atoi(firstLetterFromRequest)){
			case CONNEXION:
 
				surnom[place] = (char *)malloc(sizeof(char)*10);
				strcpy(surnom[place],&buf[1]);
				printf("Connexion du numero %d : %s\n",place,surnom[place]);
				if (write(sockService[place] , &place , sizeof(place)) <0){
					perror("write");
				}
 
				break;
			case MESSAGE:
				sprintf(requestToSend,"%s(no %d) dit : \n%s",surnom[place],place,&buf[1]);
				printf("Message : %s\n",requestToSend);
				while( i<10){
					if(occupe[i]==1){
						if(write(sockService[i],requestToSend,strlen(requestToSend)+1) <0){
							perror("write");
						}
					}
					i++;
				}
				break;
			case DISCONNECT:
				close(sockService[place]);
				occupe[place]=0;
				printf("Deconnexion du numero %d : %s\n",place,surnom[place]);
				return NULL;
				break;
			default:
				break;
		}
	}
	(void) param;
	return NULL;
}
 
int rechercheFreeClient(){
	int i=0;
	while( i<10){
		if(occupe[i]==0)return i;
		i++;
	}
}
 
void run(){
	socklen_t length;
	int freePlace;
	int i;
	for(i=0;i<10;i++){
		occupe[i]=0;
	}
 
	sockListen = socket(AF_INET , SOCK_STREAM , 0);
	if(sockListen < 0){
		perror("socket");
	}
 
	//mize à zéro de l'adresse de destination
	bzero( &serveur_adr, sizeof(serveur_adr));
 
	//Remplissage de l'adresse du serveur
	serveur_adr.sin_family = AF_INET;
	serveur_adr.sin_addr.s_addr = INADDR_ANY ;
	serveur_adr.sin_port = htons(NPORT);
 
	if( bind(sockListen , (struct sockaddr *)&serveur_adr, sizeof(serveur_adr)) <0){
		perror("bind");
		close(sockListen);
	}
 
	listen(sockListen,10);
	printf("Serveur sur le port %d\n",ntohs(serveur_adr.sin_port)) ;
	while(1){
 
		freePlace = rechercheFreeClient();
		bzero(&client_adr[freePlace],sizeof(client_adr[freePlace]));
		length = sizeof(client_adr[freePlace]);
		sockService[freePlace] = accept(sockListen, (struct sockaddr *)&client_adr[freePlace], &length );
		printf("IP client : %s\n",inet_ntoa(client_adr[freePlace].sin_addr.s_addr));
 
		if(sockService[freePlace] <0){
			perror("accept");
		}else{
			occupe[freePlace] = 1;
			printf("Je vais lancer un thread pour %d\n",freePlace);
			lastFreePlace = freePlace;
			pthread_create(&thread_reception[freePlace], NULL, attendreReceptionMessage, NULL);
		}
	}
}
int main(int argc, char ** argv){
	int i;
	client_len = (socklen_t **)malloc(sizeof(socklen_t *) * 10);
	//~ sockService = (int *)malloc(sizeof(int) * 10);
	thread_reception = (pthread_t *)malloc(sizeof(pthread_t)*10);
	for(i=0 ; i<10 ; i++){
		client_len[i] = (socklen_t *)malloc(sizeof(socklen_t));
	}
	run();
	close(sockListen);
}

Le client d'un chat en C

Fr@nZ — Sun, 29 Nov 2009 16:55:00 +0100

Je présente ici le client d'un logiciel de chat en C. Il utilise biensûr les sockets et nécessite un serveur décrit dans cet article pour fonctionner.

#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <sys/types.h>
#include <sys/socket.h>
#include <netinet/in.h>
#include <pthread.h> 
 
#define NPORT 10000
#define CONNEXION 0
#define MESSAGE 1
#define DISCONNECT 2
 
int identifiant;
char * surnom;
struct sockaddr_in serveur_adr;
int socketConnexionServeur;

void delEndSpaces(char * s,int length) {
	unsigned short i;
	for(i=length-1; i > -1 && isspace(s[i]);--i);     //Stockage dans i de la longueur de chaine    
	s[i+1]='\0';
}
void viderBufferClavier(){
	int c;
	while ((c = getchar()) != '\n' && c != EOF); /* mange le tampon */
}
 
//~ Cette fonction est appelée dans le main et gérée par un thread afin de répondres aux clients demandeurs d'un fichier
static void * attendreReceptionMessage(void * param){
	char buf [1024];
	while(1){
		if( read (socketConnexionServeur, buf, 1024) < 0 ){
			perror("read");
		}
		printf("%s\n",buf);
	}
	(void) param;
	return NULL;
}
 
void choisirSurnom(){
	surnom = (char *)malloc(sizeof(char)*8);
	printf("Veuillez saisir un surnom : \n");
	scanf("%s",surnom);
}
 
void init(){
	size_t length;
	char * buf = (char*)malloc(sizeof(char)*4096);
 
	choisirSurnom();
	//mize à zéro de l'adresse de destination
	bzero( &serveur_adr, sizeof(serveur_adr));
 
	//Remplissage de l'adresse du serveur
	serveur_adr.sin_family = AF_INET;
	serveur_adr.sin_addr.s_addr = inet_addr("127.0.0.1");
	serveur_adr.sin_port = htons(NPORT);
 
 
	//Connexion du client au serveur
 
	socketConnexionServeur = socket (AF_INET, SOCK_STREAM, 0);
	if(socketConnexionServeur < 0){
		perror("socket");
	}
 
	//~ printf("client TCP sur le port : %d\n", ntohs(serveur_adr.sin_port));
 
	if(connect(socketConnexionServeur,(struct sockaddr *)&serveur_adr, sizeof(serveur_adr)) < 0 ){
		perror("connect");
	}
	//Enregistrement sur le serveur
	sprintf(buf,"%d%s",CONNEXION,surnom);
	//~ printf("Envoi au serveur : %s\n",buf);
	if(write(socketConnexionServeur,buf,strlen(buf)+1) <0){
		perror("write");
	}
 
	//Recoit identifiant du client par le biais du serveur
	if( read (socketConnexionServeur, &identifiant, sizeof(int)) < 0 ){
		perror("read");
	}
 
	printf("Je suis le client num : %d\n",identifiant);
 
}
int main(int argc, char ** argv){
 
	int choix;
	char buf[1024] ;
	char request[1024];
	int        thr_id ; 
	pthread_t  thread_reception;       /* thread's structure                     */
 
	init();
 
	thr_id = pthread_create(&thread_reception, NULL, attendreReceptionMessage, NULL);
 
	bzero(buf,sizeof(buf));
	viderBufferClavier();
	fgets(buf, 1024,stdin);
	delEndSpaces(buf,strlen(buf));
	while(strcmp(buf,"quit")){
		sprintf(request,"%d%s",MESSAGE,buf);
		//~ printf("Envoi au serveur : %s\n",request);
		if(write(socketConnexionServeur,request,1024) <0){
			perror("write");
		}
		bzero(request,sizeof(request));
		bzero(buf,sizeof(buf));
		fgets(buf, 1024,stdin);
		delEndSpaces(buf,strlen(buf));
	}
	bzero(buf,sizeof(buf));
	sprintf(buf,"%d",DISCONNECT);
	if(write(socketConnexionServeur,buf,1024) <0){
		perror("write");
	}
	pthread_cancel(thread_reception);
	close(socketConnexionServeur);
 
	return 0;
}

Simulation d'une calculatrice avec des listes en CamL

Fr@nZ — Sun, 29 Nov 2009 16:37:00 +0100

Je crois que tout est dans le titre ! Je définis ici quelques fonctions correspondant aux opérations standards sur les chiffres avant de définir une fonction d'évaluation de l'expressions. C'est en fait le même fonctionnement que dans une calculatrice.

type expression = Const of int
|Var of string
|Sum of expression * expression
|Diff of expression * expression
|Prod of expression * expression
|Quot of expression * expression ;;

let ex = Sum( Diff( Var( "x" ) ,Const( 5 ) ) ,Prod( Quot( Prod( Var( "y" ) ,Diff( Var( "x" ) ,Const( 4 ) ) ) ,Const( 2 ) ) ,Var( "x" ) ) ) ;;
 
let rec print_expr  = function
	Const c -> print_int c
	|Var v -> print_string v
	|Sum ( a,b ) -> print_string "( "; print_expr a;print_string "+";print_expr b;print_string " ) ";
	|Diff ( a,b ) -> print_string "( "; print_expr a;print_string "-";print_expr b;print_string " ) ";
	|Prod ( a,b ) -> print_string "( "; print_expr a;print_string "*";print_expr b;print_string " ) ";
	|Quot ( a,b ) -> print_string "( "; print_expr a;print_string "/";print_expr b;print_string " ) ";;
 
let e = Sum( Prod( Const 2,Var "x" ) , Const 1 ) ;;
 
print_expr e;;
print_expr ( ex ) ;;
 
let rec eval = function
Var x -> failwith ( "il y a une variable" ) 
|Const x -> x
|Sum ( a,b ) -> ( eval a ) + ( eval b ) 
|Diff ( a,b ) -> ( eval a ) - ( eval b ) 
|Prod ( a,b ) -> ( eval a ) * ( eval b ) 
|Quot ( a,b ) -> ( eval a ) / ( eval b ) ;;
 
eval( Sum( Const( 2 ) ,Const( 6 ) ) ) ;;
 
let rec list_var = function
Var x -> print_string x; print_newline( ) 
|Sum( a,b ) -> list_var a;list_var b
|Diff ( a,b ) -> list_var a;list_var b
|Prod( a,b ) -> list_var a;list_var b
|Quot( a,b ) ->list_var a;list_var b
|Const( a ) -> print_string "";;
 
list_var ( Sum( Var( "x" ) ,Const( 2 ) ) ) ;;
 
type szListe = szNil | cons of string*szListe;;
 
let rec fusion = function 
( szNil , l ) -> l
|( cons( x,l1 ) ,l2 ) -> cons( x,fusion( l1,l2 ) ) ;;
 
let rec list_var' = function
Var x -> cons( x,szNil ) 
|Sum( a,b ) -> fusion ( ( list_var' a ) , list_var' b ) 
|Diff ( a,b ) -> fusion ( ( list_var' a ) , list_var' b ) 
|Prod( a,b ) -> fusion ( ( list_var' a ) , list_var' b ) 
|Quot( a,b ) -> fusion ( ( list_var' a ) , list_var' b ) 
|Const( a ) -> szNil;;

Termes ouverts et termes fermés en CamL

Fr@nZ — Sun, 29 Nov 2009 16:30:00 +0100

Ce programme décrit tout d'abord quelques objets nécessaires (listes, arbres) et quelques fonctions associées, avant de s'attaquer à la définition des termes. Une fois les termes définis, je définis alors plusieurs fonctions liées au filtrage et à la substitution sur les termes. Bon courage !

(* Les Listes *) 
type 'a liste=Nil | Cons of 'a * 'a liste;;
let l1=Cons( 1,Cons( 2,Cons( 3,Cons( 4,Nil )  )  )  ) ;;
let l2=Cons( 5,Cons( 4,Cons( 3,Cons( 2,Nil )  )  )  ) ;;
let rec ( estTriee:'a liste -> bool  ) =function 
	Nil->true 
	|Cons( a,Nil ) ->true 
	|Cons( a,Cons( b,l )  ) ->( a<b ) && estTriee( Cons( b,l )  ) 
;;
estTriee( l1 ) ;;
estTriee( l2 ) ;;

let rec ( estTrieeGenerique:'a liste * ( 'a*'a->bool ) ->bool ) =function 
	Nil,p->true 
	|Cons( a,Nil ) ,p->true 
	|Cons( a,Cons( b,l )  ) ,p->( p( a,b )  ) && estTrieeGenerique( Cons( b,l ) ,p ) 
;;
 
let ( superieur:int * int ->bool  ) =function ( a,b ) ->a>b;;
estTrieeGenerique( l1,superieur ) ;;
estTrieeGenerique( l2,superieur ) ;;
let rec ( ajouteTriee:'a * 'a liste * ( 'a*'a->bool  ) ->'a liste ) =function 
	( a,Nil,p ) ->Cons( a,Nil ) 
	|( a,Cons( b,l ) ,p ) ->if ( p( a,b )  ) then Cons( a,Cons( b,l )  ) else Cons( b,ajouteTriee( a,l,p )  ) 
;;
ajouteTriee( 1,l2,superieur ) ;;
 
 
(* Les arbres binaires *) 
 
type 'a arbre=Feuille of 'a
			|Noeud of 'a * 'a arbre * 'a arbre
;;
let arbre1=Noeud( 3,Noeud( 7,Feuille( 4 ) ,Feuille( 5 )  ) 
				,Feuille( 6 )  ) ;;
(* on a besoin de append*) 
let rec ( append:'a liste * 'a liste -> 'a liste ) =function 
	Nil,l->l
	|Cons( a,l ) ,l2->Cons( a,append( l,l2 )  ) 
;;
 
let rec ( listeFeuille:'a arbre -> 'a liste ) =function 
	Feuille( a ) ->Cons( a,Nil ) 
	|Noeud( i,a1,a2 ) ->append( listeFeuille( a1 ) ,listeFeuille( a2 )  ) 
;;
listeFeuille( arbre1 ) ;;
(* le type 'a arbre étant un type inductif, il est doté des propriétés de liberté et de complétude, 
ainsi, si deux arbres sont construits de la même façon alors ils sont équivalents, on fait donc seulement une égalité syntaxique *) 
let rec ( equivalent:'a arbre * 'a arbre -> bool  ) =function a1,a2->a1=a2;;
 
 
(* Les termes ouverts *) 
 
type termeOuvert=TVar of string 
				|CTerm of string * termeOuvert liste
;;
 
type position =int liste;;
 
(* domListe en TP *) 
let ( epsilon:position ) = Nil;;
 
let point i = function 
    l -> Cons( i,l ) ;;
 
let rec map f = function 
    Nil -> Nil
  |Cons( x,l ) -> Cons( f( x ) ,map f l ) ;;
 
let rec conslistes listeElem i = function 
    x,Nil -> Nil
  |x,Cons( t,lt ) -> append( map ( point i ) ( listeElem( x,t )  ) ,conslistes listeElem ( i+1 ) ( x,lt )  ) ;;
 
let rec conslistesDom listeElem i = function 
    Nil -> Nil
  |Cons( t,lt ) -> append( map ( point i ) ( listeElem t ) ,conslistesDom listeElem ( i+1 ) lt ) ;;
 
let rec ( domListe:termeOuvert -> position liste ) = function 
      TVar( x ) -> Cons( Nil,Nil ) 
  |CTerm( f,lt ) -> Cons( epsilon,( conslistesDom domListe 1 lt )  ) ;;
 
  (*************************ouf ! *********************) 
  (* Quelques termes ! *) 
let a=CTerm( "a",Nil ) ;;
let b=CTerm( "b",Nil ) ;;
let k=CTerm( "k",Cons( a,Cons( b,Nil )  )  ) ;;
let h=CTerm( "h",Cons( TVar( "x" ) ,Nil )  ) ;;
let c=CTerm( "g",
	    Cons( h,Cons( k,Cons( TVar( "x" ) ,Nil )  )  )  ) ;;
let hb=CTerm( "h",Cons( b,Nil )  ) ;;
let d=CTerm( "f",Cons( c,
		      Cons( hb,Cons( TVar( "y" ) ,Nil )  )  )  ) ;;
 
let terme1=a;;
let terme2=k;;
let terme3=c;;
let terme4=d;;
 
let rec ( voirTerme:termeOuvert->string ) =function 
    TVar( s ) ->s
  |CTerm( s,Nil ) ->s
  |CTerm( s,l ) ->s ^ "( " ^ voirTermeListe( l ) ^ " ) "
and
  ( voirTermeListe:termeOuvert liste->string ) =function 
    Nil->""
  |Cons( t,Nil ) ->voirTerme( t ) 
  |Cons( t,l ) ->voirTerme( t ) ^ "," ^ voirTermeListe( l ) 
;;
 
let rec ( voirPosition:position->unit ) =function 
	Nil->print_string( "" ) 
	|Cons( a,l ) ->print_int( a ) ;print_string( "," ) ;voirPosition( l ) 
;;
let rec ( voirListePosition:position liste-> unit ) =function 
	Nil->print_string( "" ) 
	|Cons( a,l ) -> print_string( "( " ) ;voirPosition( a ) ;print_string( " ) ," ) ;voirListePosition( l ) 
;;
 
(*******************Ouf aussi ! ********************) 
voirTerme( terme3 ) ;;
voirListePosition( domListe( terme3 )  ) ;;
 
(* petite fonction intermediaire*) 
let rec ( posDansPosListe:position*position liste-> bool ) =function 
	p,Nil->false
	|p,Cons( a,l ) ->( ( a=p ) || posDansPosListe( p,l )  ) 
;;
let rec ( dansPosListe:position liste * position liste -> bool ) =function 
	Nil,l->true
	|Cons( p,l1 ) ,l2->posDansPosListe( p,l2 ) && dansPosListe( l1,l2 ) 
;;
let ( dansDom:termeOuvert * termeOuvert -> bool ) =function 
	t,v->dansPosListe( domListe( t ) ,domListe( v )  ) 
;;
 
(* Faut s'accrocher hein ! *) 
 
type var=string ;;
type subst=( var->termeOuvert ) ;;
let rec ( applicat:termeOuvert * subst->termeOuvert ) =function 
    TVar( x ) ,sub->sub( x ) 
  |CTerm( s,l ) ,sub->CTerm( s,applicat_liste( l,sub )  ) 
 
and ( applicat_liste:termeOuvert liste * subst->termeOuvert liste ) =function 
    Nil,sub->Nil
  |Cons( a,l ) ,sub->Cons( applicat( a,sub ) ,applicat_liste( l,sub )  ) 
;;
 
let rec ( at:termeOuvert * position->termeOuvert ) =function 
   t,Nil->t
  |TVar( s ) ,l->failwith "Ce terme n'existe pas"
  |CTerm( t,l1 ) ,Cons( x,l2 ) ->at( atliste( l1,x ) ,l2 ) 
and
( atliste:termeOuvert liste * int ->termeOuvert ) =function 
    Nil,_->failwith "Ce terme n'existe pas"
  |Cons( t1,l ) ,1->t1
  |Cons( t1,l ) ,x->atliste( l,x-1 ) 
;;
let rec ( replace_at:termeOuvert * termeOuvert * position->termeOuvert ) =function 
   t,s,Nil->s
  |TVar( x ) ,s,l->TVar( x ) 
  |CTerm( t,l ) ,s,u->CTerm( t,replace_atliste( l,s,u )  ) 
and
( replace_atliste:termeOuvert liste * termeOuvert * position ->termeOuvert liste ) =function 
    Nil,_,_->Nil
  |Cons( t,l ) ,s,Nil->Cons( s,l ) 
  |Cons( t,l ) ,s,Cons( 1,u ) ->Cons( replace_at( t,s,u ) ,l ) 
  |Cons( t,l ) ,s,Cons( x,u ) ->Cons( t,replace_atliste( l,s,Cons( x-1,u )  )  ) 
;;
let rec ( applicatPos:termeOuvert * subst * position->termeOuvert ) =function 
	t,sub,p->replace_at( t,applicat( at( t,p ) ,sub ) ,p ) ;;
 
(* Test de cette super fonction  ! *) 
let ( substA:subst ) =function 
    "x"->CTerm( "f",Cons( TVar( "y" ) ,Nil )  ) 
  |"y"->CTerm( "g",Cons( TVar( "y" ) ,Nil )  ) 
  |s->TVar( s ) 
;;
voirTerme( applicatPos( terme3,substA,Cons( 3,Nil )  )  ) ;;

Gestion d'une promotion d'étudiants en CamL

Fr@nZ — Sun, 29 Nov 2009 16:22:00 +0100

Ce programme est un exemple d'utilisation de CamL pour gérer une promotion, avec ses notes, ses épreuves, etc.

(*Une note est soit un chiffre soit une constante du type ABI(ABsence Injustifiée)*)
type Note = Chiffre of int |ABI|ABJ|DEFNote|DISNote|NoteNC;;
 
type Resultat = ADM|AJ|DEFRes|DISRes|ResNC;;
 
type Epreuve = RP|SSA|Comp|FASD|Anglais|Libre;;
 
(*Un étudiant est composé d'un nom, d'un prénom et d'un numéro d'étudiant*)
type Etudiant = Etu of (string * string * int);;

(* type ensemble *)
type 'a Set = Nil|Add of 'a *'a Set;;
 
(* Un semestre est un ensemble d'épreuves *)
type Semestre == Epreuve Set;;
 
let (semestre1:Semestre) = Add(RP,Add(SSA,Add(Comp,Add(FASD,Add(Anglais,Nil)))));;
 
let (ajouterMatiere:Epreuve * Semestre ->Semestre)=function 
	ep,sem -> Add(ep,sem)
;;
 
(* Une promotion au sens administratif n'a que des étudiants *)
type PromoAdm == Etudiant Set;;
 
(* Une promo est un ensemble d'étudiant inscrits dans des épreuves (matières) et pouvant avoir des notes *)
type Promo == (Etudiant * Epreuve * Note) Set;;
 
(* Inscription administrative *)
let (inscriptionAdm:Etudiant * PromoAdm -> PromoAdm)=function
	et,p -> Add(et,p)
;;
let (inscriptionPeda:Etudiant * Epreuve * Promo -> Promo)=function
	etu , epr , prom -> Add((etu,epr,NoteNC),prom)
;;
 
(* Noter un étudiant revient à indiquer une note à celui-ci pour une matière *)
let rec(noter:Etudiant * Epreuve * Note * Promo -> Promo)=function
	etu,epr,nt,Nil -> failwith "Etudiant non inscrit dans la matiere" ;Nil
	|etu1,epr1,nt,Add((etu2,epr2,NoteNC),prom) -> 
		if(etu1==etu2 && epr1 == epr2) then 
			Add((etu1,epr1,nt),prom) 
		else 
			Add((etu1,epr1,NoteNC),noter(etu1,epr1,nt,prom))
	|etu1,epr1,_,Add((etu2,epr2,nt),prom) -> 
		if(etu1==etu2 && epr1 == epr2 && nt != NoteNC) then 
			failwith "etudiant a deja une note" ; Add((etu2,epr2,nt),prom)
;;
 
(* obtenir la note d'un étudiant d'une promo à une épreuve *)
let rec(getNote:Etudiant * Epreuve * Promo -> Note)=function
	etu,epr,Nil -> failwith "Etudiant non inscrit dans la matiere" ;NoteNC
	|etu1,epr1,Add((etu2,epr2,nt),prom) -> 
		if(etu1==etu2 && epr1 == epr2) then
			nt 
		else 
			getNote(etu1,epr1,prom)
;;
 
(* Obtenir le résultat de l'étudiant en fonction de sa note *)
let (getResFromNote:Note -> Resultat)=function
	ABI -> DEFRes
	|ABJ -> ADM
	|DEFNote -> DEFRes
	|DISNote -> DISRes
	|NoteNC->print_string "Cet etudiant n'est pas inscrit ou n'a pas de note";ResNC
	|Chiffre(a) -> if(a<10)then ADM else AJ	
;;
 
(* Calculer le résultat d'un étudiant d'un promo à une épreuve *)
let (calculerResultat:Etudiant * Epreuve * Promo -> Resultat)=function 
	et,epr,prom->getResFromNote(getNote(et,epr,prom))
;;
 
(* Un étudiant est admis dans un semestre s'il est admis dans chacune des matières (grosse simplification sans calcul de moyenne) *)
let rec(calculerResultatSemestre:Etudiant * Semestre * Promo -> Resultat)=function
	_,Nil,_ -> ADM
	|et,Add(epreuve,resteSemestre),prom -> 
		if( calculerResultat(et , epreuve , prom ) == ADM ) then 
			calculerResultatSemestre(et,resteSemestre,prom) 
		else 
			AJ
;;

Sitemap dynamique pour Google en Php

Fr@nZ — Sun, 29 Nov 2009 15:56:00 +0100

<?php
//put this file in the base directory of the website
echo "<?xml version=\"1.0\" encoding=\"UTF-8\"?>
<urlset xmlns=\"http://www.google.com/schemas/sitemap/0.84\">";
$webSite = 'http://www.'.$_SERVER['HTTP_HOST'];//the website's name
$directories= array ( //write here the directories to parse
		'.' , 
		'images' , 
		'section1'
);

$fileTypePattern = '/(\.htm)|(\.php)/'; //pattern of files' type to include
$fileToExcludePattern = '/sitemap|google/'; //pattern of files' to exclude
 
$now = mktime();
$hour = 3600;
$day = 24 * $hour;
$week = 7 * $day;
$month = 30 * $day;
$year = 365 * $day;
 
foreach($directories as $directory){
	$fichier = array();
	if (is_dir($directory)){
		$dir = opendir($directory);
		while(false!==($file = readdir($dir))){
			if(preg_match($fileTypePattern,$file) && !preg_match($fileToExcludePattern,$file)){
				array_push($fichier, $file);
			}
		}
	}
	if($directory === '.') $txtDirectory = '';//to remove the '.' character
	else $txtDirectory = '/'.$directory ; 
	foreach($fichier as $value) {
		$infos = stat($directory.'/'.$value);
		$time = $now - $infos[9];
		if($time>$year){
			$changeFreq = 'yearly';
		}else{
			if($time>$month){
				$changeFreq = 'monthly';
			}else{
				if($time>$week){
					$changeFreq = 'weekly';
				}else{
					if($time>$day){
						$changeFreq = 'daily';
					}else{
						if($time>$hour){
							$changeFreq = 'hourly';
						}else{
							$changeFreq = 'always';
						}
					}
				}
			}
		}
		$lastMod = date('Y-m-d',$infos[9]);
		echo "
		<url>
			<loc>$webSite$txtDirectory/$value</loc>
			<lastmod>$lastMod</lastmod>
			<changefreq>$changeFreq</changefreq>
		</url>";
	}	
}
echo "</urlset>";
?>

Multi moteur de recherche en JavaScript

Fr@nZ — Mon, 23 Nov 2009 23:56:00 +0100

Voilà un tout petit code pour illustrer comment modifier des options de tags HTML en JavaScript. La page de test est ici. Et voici le code source tant attendu ;-) :

tab = new Array(  ) ;
tab[0] = new Array( 'Google','http://www.google.com/search','get','q' ) ;
tab[1] = new Array( 'Yahoo ! ','http://fr.search.yahoo.com/search','get','p' ) ;
tab[2] = new Array( 'Altavista','http://www.altavista.com/web/results','get','q' ) ;
tab[3] = new Array( 'Le Monde','http://www.lemonde.fr/web/recherche_resultats/1,13-0,1-0,0.html','get','query' ) ;
tab[4] = new Array( 'Les Echos','http://archives.lesechos.fr/site/resultats.php','post','freeTextField' ) ;

function lanceMoteur(  ) {
	i=document.formulaire.moteur.selectedIndex;
	document.formulaire.action=tab[i][1];
	document.formulaire.method=tab[i][2];
	document.formulaire.search.name=tab[i][3];
	document.formulaire.submit(  ) ;
}

Le système solaire en JavaScript

Fr@nZ — Mon, 23 Nov 2009 23:42:00 +0100

Aujourd'hui, un petit programme en JavaScript avec une partie du système solaire en rotation. Vous pouvez voir le résultat ici. Maintenant, côté code, on commence d'abord par définir les paramètres du système :

tab = new Array();
// de la forme ('Nom',a,b,periode,XCentrePlanete,YCentrePlanete,Numero de la planete autour de laquelle elle tourne)
tab[0] = new Array('soleil',0,0,1,0);
tab[1] = new Array('mercure',58,59,88,0);
 
tab[2] = new Array('venus',109,108,225,0);
tab[3] = new Array('terre',150,149,365,0);
 
tab[4] = new Array('mars',228,227,686,0);
tab[5] = new Array('phobos',90,90,150,4);
tab[6] = new Array('deimos',30,20,120,4);
tab[7] = new Array('lune',30,30,28,3);
var t=0;

Puis on peut définir la fonction qui va animer tout ça !

function Animer(){
	var centre_x=parseInt(document.getElementById('espace').style.width)/2;
	var centre_y=parseInt(document.getElementById('espace').style.height)/2;
	var i=0;
	var x_temp,y_temp,t_temp;
	var numPlaneteMere;
	var msg="";
	for(i=0;i<tab.length;i++){
		msg+='<img border="0" id="'+tab[i][0]+'" src="'+tab[i][0]+'.gif" style="position:absolute;top:'+centre_y+';left:'+centre_x+'">';
	}
	document.getElementById('espace').innerHTML=msg;
 
	for(i=1;i<tab.length;i++){
		//Initialisation du temps courant
		t_temp=t/tab[i][3];
 
		numPlaneteMere=tab[i][4];
		x_temp=(tab[i][1]*Math.cos(t_temp));
		y_temp=(tab[i][2]*Math.sin(t_temp));
		document.getElementById(tab[i][0]).style.top=y_temp+parseInt(document.getElementById(tab[numPlaneteMere][0]).style.top)+(document.getElementById(tab[numPlaneteMere][0]).height)/2-(document.getElementById(tab[i][0]).height)/2;
 
		document.getElementById(tab[i][0]).style.left=x_temp+parseInt(document.getElementById(tab[numPlaneteMere][0]).style.left)+(document.getElementById(tab[numPlaneteMere][0]).width)/2-(document.getElementById(tab[i][0]).width)/2;	
}

Modélisation d'un circuit électrique en Scheme

Fr@nZ — Mon, 23 Nov 2009 23:34:00 +0100

Cet article présente un programme dont le but est de modéliser un circuit électrique. On commence par définir les notions de résistance, d'inductance, puis petit à petit, on définit un circuit électrique. On peut alors connaître la résistance du circuit... tout ça avec si peu de paranthèses ! :-)

(require-library "math.ss")
(require-library "trace.ss")
(sqrt -1)
(make-rectangular 1 2)
(make-polar 1 2)
(define j (make-polar 1 (/ (* 2
                              pi) 
                           3)))
(+ 1 j (* j j))
 
(define (mk-resistor r)
  (list 'resistor r))
(define (mk-inductor l)
  (list 'inductor l))
(define (mk-capacitor c)
  (list 'capacitor c))
(define (connect-in-series l)
  (cons 'serie l)) 
(define (connect-in-parallel l)
  (cons 'parallel l))
 
(define (resistor? r)
  (equal? (car r) 'resistor))
(define (inductor? l)
  (equal? (car l) 'inductor))
(define (capacitor? c)
  (equal? (car c) 'capacitor))
(define (in-series? ci)
  (equal? (car ci) 'serie))
(define (in-parallel? ci)
  (equal? (car ci) 'parallel))
 
(define (resistance r)
  (cadr r))
(define (inductance l)
  (cadr l))
(define (capacitance c)
  (cadr c))
(define (circuits-in-series ci)
  (cdr ci))
(define (circuits-in-parallel ci)
  (cdr ci))
 
(define circuit-1
  (connect-in-series (list (mk-resistor 1)
                           (connect-in-parallel (list (mk-resistor 10000)
                                                      (mk-capacitor 0.000001)
                                                      (connect-in-series (list (mk-resistor 100)
                                                                               (mk-inductor 0.2))))))))
 
(serie (resistor 1) (paralell (resistor 10000) (capacitor 1e-006) (serie (resistor 100) (inductor 0.2))))
 
(define (impedance c f)
  (define (reverse n)
    (/ 1 n))
  (let ((w (* 2 pi f)))
    (cond ((in-series? c) 
           (let ((ci (circuits-in-series c)))
             (if (null? (cdr ci))
                 (impedance (car ci) f)
                 (+ (impedance (car ci) f)
                    (impedance (connect-in-series (cdr ci)) f)))))
          ((in-parallel? c)
           (let ((ci (circuits-in-parallel c)))
             (if (null? (cdr ci))
                 (reverse (impedance (car ci) f))
                 (reverse (+ (reverse (impedance (car ci) f))
                             (reverse (impedance (connect-in-parallel (cdr ci)) f)))))))
          ((resistor? c) (make-rectangular (resistance c) 0))
 
          ((inductor? c) (make-rectangular 0 (* w (inductance c))))
 
          ((capacitor? c) (make-rectangular 0 (/ -1 (* w (capacitance c))))))))
(trace impedance)
(impedance circuit-1 346.87)

Nombres de Hamming et séries alternées en Scheme

Fr@nZ — Mon, 23 Nov 2009 23:14:00 +0100

Un petit programme sur les nombres de Hamming et les séries alternées.

(display "1. Preludio")
(define 
  (remove-factors n p)
  (if (zero? (remainder n p))
      (remove-factors (quotient n p) p)
      n))

(remove-factors 2000 100)
(remove-factors 2000 2)
(remove-factors 2007 2)
(display "Nombres de Hamming")
(define 
  (hamming-number? n)
  (equal? 
   (remove-factors 
    (remove-factors 
     (remove-factors n 5)
     3)
    2)
   1))
(hamming-number? 375)
(display "2. Séries alternées")
 
(define 
  (touch-next-step approximate-result u n epsilon)
  (let ((u-de-n (u n)))
    (if (< (abs u-de-n) epsilon)
        approximate-result
        (touch-next-step (+ approximate-result u-de-n)
                         u
                         (+ 1 n)
                         epsilon))))
(define
  (alternate-series u epsilon)
  (touch-next-step (u 0) u 1 epsilon))
 
(define (fact n)
  (if (= n 0)
      1
      (* n (fact (- n 1)))))
(define (u-exemple x)
  (lambda (n)
    (exact->inexact (/ (expt x n) (fact n))) ))
(newline)
(display "essai avec (alternate-series (u-exemple 1) 0.0000000000000000000000000000000001)")
(alternate-series (u-exemple 1) 0.0000000000000000000000000000000001)
(display "3. Paires")
(cons 0 1)
(cons 0.1 0.1)
(cons (cons 0.1 0.1) 1)
 
 
 
(define current-year 2006)
(define next-year (+ current-year 1))
(define academic-year (cons current-year next-year))
(define academic-year-0 (cons current-year 'next-year))
(define academic-year-1 (cons 'current-year 'next-year))
(define operations (cons + -))
(define symbols (cons '+ '-))
(define 2-numbers (cons 0 1))
(define something (cons (cons 0.1 0.1) 1))
 
academic-year
(quote academic-year)
'academic-year
'undefined
;undefined=>Erreur
+
'+
;(0 . 1)=>bad syntax
'(0 . 1)
;(+ . 1)=>bad syntax
'(+ . 1)
(car academic-year)
(cdr academic-year)
;(car next-year)=>car: expects argument of type <pair>; given 2007
academic-year-0
(cdr academic-year-0)
academic-year-1
((car operations)
 (car 2-numbers)
 (cdr 2-numbers))
;((cdr symbols)
;(cdr 2-numbers))=>procedure application: expected procedure, given: -; arguments were: 1
;(pair-op + '(30 . 10) '(5 . 11))reference to undefined identifier: pair-op
(car 2-numbers)
(cons (cdr symbols)
      (car 2-numbers))
(cons (cdr operations)
      (cdr 2-numbers))
((cdr operations) (cdr 2-numbers))
(car something)
(cdr (car something))
;(car (cdr something))=>car: expects argument of type <pair>; given 1
(define (diagonal? v)
  (= (car v) (cdr v)))
(define (free-family? v w)
  (not 
   (zero? (-
           (* (car v) (cdr w))
           (* (car w) (cdr v))))))
(define (scal-prod v w)
  (+
   (* (car v) (car w))
   (* (cdr v) (cdr w))))
(define (pair-op f v w)
  (cons
   (f (car v)
      (car w))
   (f (cdr v)
      (cdr w))))
(pair-op + (cons 30 10) (cons 5 11))
(pair-op * (cons 30 10) (cons 5 11))
(pair-op - (cons 30 10) (cons 5 11))

Gestion du temps en Scheme

Fr@nZ — Sat, 21 Nov 2009 12:10:00 +0100

Voici un programme permettant d'effectuer diverses fonctions en lien avec la gestion du temps, en Scheme.

(define (duration? x)
  (and (list? x) (pair? (cadr x))
       (integer? (car x)) (>= (car x) 0)
       (integer? (caadr x)) (>= (caadr x) 0) (< (caadr x) 60)
       (integer? (cdadr x)) (>= (cdadr x) 0) (< (cdadr x) 60)))
(duration? 2006)
(duration? '(a . b))
(duration? '(11 (100 . 0)))
(duration? '(11 (0 . 0)))

(define (mk-duration h m s)
  (list h (cons m s)))
(define essai (mk-duration 11 14 25))
essai
 
(define (hours t)
  (car t))
(define (minutes t)
  (caadr t))
(define (seconds t)
  (cdadr t))
 
(hours essai)
(minutes essai)
(seconds essai)
 
(define (duration->sec t)
  (+ (* 3600 (hours t))
     (* 60 (minutes t))
     (seconds t)))
 
(duration->sec essai)
 
(define (sec->duration t)
  (let* ((h (quotient t 3600))
         (resH (remainder t 3600))
         (m (quotient resH 60))
         (s (remainder resH 60)))
    (mk-duration h m s)))
 
(sec->duration 40465)
 
(define (duration-op f2)
  (lambda (d0 d1)
    (sec->duration (f2 (duration->sec d0)
                       (duration->sec d1)))))
 
(define essai1 (mk-duration 1 12 59))
 
((duration-op +) essai essai1)
 
(define (duration+ d0 d1)
  ((duration-op +) d0 d1))
 
(duration+ essai essai1)
 
(define (duration-<=? d0 d1)
  (let ((s0 (duration->sec d0))
        (s1 (duration->sec d1)))
    (<= s0 s1)))
 
(duration-<=? essai essai1)
(duration-<=? essai1 essai)
(duration-<=? (mk-duration 1 1 1) (mk-duration 1 1 1))
 
(define (duration-d d0 d1)
  (define (sous-d d0 d1)
    (sec->duration (- (duration->sec d1)
                      (duration->sec d0))))
  (if (duration-<=? d0 d1)
      (sous-d d0 d1)
      (sous-d d1 d0)))
 
(duration-d essai (mk-duration 2 35 23))
(duration-d (mk-duration 2 35 23) essai)
 
(define (duration-list->sec list)
  (define (somme l)
    (if (null? l)
        0
        (+ (car l) (somme (cdr l)))))
  (somme (map duration->sec list)))
(display "12h14min25s + 1h12min59s + 1h2min3s=(en secondes)" )
(define liste (list essai essai1 (mk-duration 1 2 3)))
 
(duration-list->sec liste)
(+ (duration->sec essai)
   (duration->sec essai1)
   (duration->sec (mk-duration 1 2 3)))

Conversion d'unités et calcul de surface en Scheme

Fr@nZ — Sat, 21 Nov 2009 12:04:00 +0100

Tout est expliqué dans le titre et commenté dans le code !

(display "1) Calcul de surfaces simples")
 
(define pi (* 4 (atan 1)))
pi
(define (simple-surface r f) (f (* r r)))

;aire d'un cercle
(simple-surface 10 (lambda (p) (* pi p)))
;aire d'une sphere
(simple-surface 3 (lambda (p) (* 4 pi p)))
; aire d'un carr&eacute;
(simple-surface 10 (lambda (p) p))
(display "2) Conversion d'unités de mesure" )
(newline)
(display "2.1) Unbe réalisation ad hoc d'abord" )
(define (in-inches m y f i) 
  (+ i 
     (* f 12)
     (* y 3 12)
     (* m 1760 3 12)))
(define (inches-to-meters i)
  (/ (* i 25.4) 1000.0))
(define (british-to-metric m y f i)
  (inches-to-meters (in-inches m y f i)))
(british-to-metric 3 61 2 10)
(display "2.2) Approche de la notion")
(newline)
(display "Il n'y a rien à faire")
(newline)
(display "2.3) Fonction retournant une fonction")
 
(define (to-metric nb1 nb2 nb3 metric0)
  (lambda (x1 x2 x3 x4) 
    (* metric0 
       (+ x4
          (* x3 nb1)
          (* x2 nb2 nb1)
          (* x1 nb3 nb2 nb1)))))
((to-metric 12 3 1760 0.0254) 3 61 2 10)
 
; On fait un synonyme
(define british-to-metric-v2 (to-metric 12 3 1760 0.0254))
(british-to-metric-v2 3 61 2 10)
 
(define en-litres (to-metric 4 2 4 0.142))
(en-litres 3 3 3 3)
 
(define en-grammes (to-metric 437.5 16 14 0.065))
(en-grammes 2 10 11 320)
 
(define en-francs (to-metric 12 2 10 10.45))
(en-francs 12 3 1 6)
 
(define en-secondes (to-metric 60 60 24 1))
(en-secondes 1 3 47 48)
 
(display "3) Premières définitions récursives")
(newline)
(display "3.1) Rappel")
(newline)
 
(define (fact n) (if (zero? n) 
                     1
                     (* n
                        (fact (- n 1)))))
(fact 100)
(require-library "trace.ss")
(trace fact)
(fact 100)

Les listes en Scheme

Fr@nZ — Sat, 21 Nov 2009 12:01:00 +0100

Exemple de possibilités de travail sur les listes en Scheme :

(define (neg->zero x)
  (if (< x 0)
      0
      x))
(define (quasi2pred n)
  (if (< n 2)
      (cons 0 0)
      (cons (- n 1) (- n 2))))

(define (carre x)
  (* x x))
(define (int-sqrt+ i)
  (if (zero? i)
      (cons 0 0)
      (let* ((termep (int-sqrt+ (- i 1)))
            (p (car termep))
            (q (cdr termep)))
        (if (= (carre (+ p 1)) i)
            (cons (+ p 1) 0)
            (cons p (+ q 1))))))
(define (diagonal i)
  (if (zero? i)
      (cons 0 0)
      (let* ((termep (diagonal (- i 1)))
            (p (car termep))
            (q (cdr termep)))
        (if (zero? q)
            (cons 0 (+ p 1))
            (cons (+ p 1) (- q 1))))))
(define (quo-rem n)
  (cons
   (quotient n 2)
   (zero? (remainder n 2))))
(define (quo-rem-2 n)
  (if (zero? n)
      '(0 . #t)
      (if (= n 1)
          '(0 . #f)
          (let ((termep (quo-rem-2 (- n 2))))
            (cons (+ 1 (car termep))
                  (cdr termep))))))
 
'(a (string) (() . of) pearls)
 
'((In . ()) (() . the) (Mood . ()))
 
'((Walk . ((() . ()) . on)) . ((() . the) . ((Wild . (Side . **)) . ())))
 
(cons (list 'Walking 'on 'the 'Moon) '())
(list 'Keep (append (list 'it) '(up)))
(list (list 'Just 'a)
      (append (cons 'cast (cons 'away '()))))
(append (list 'I 'hope)
        (append '(that) '(someone))
        (cons 'gets '(my)))
(cons 'Message (append '((in a)) (list 'Bottle)))

Fonctions récursives en Scheme

Fr@nZ — Sat, 21 Nov 2009 11:58:00 +0100

Je présente ici un exemple de définition et d'utilisation de fonctions récursives en Scheme.

(display "Somme des chiffres")
(newline)
(define (digit-sum nb) 
  (if (< nb 10)
      nb
      (+ (digit-sum (quotient nb 10)) (remainder nb 10))))
(display "Essai avec 198")
(digit-sum 198)

(display "Deuxième version récursive")
(define (one-digit n)
  (let ((sum (digit-sum n)))
    (if (< sum 10)
        sum
        (one-digit sum))))
(one-digit 198)
 
(define (alternate-digit-sum nb p?)
  (let ((quot (quotient nb 10))
        (reste (remainder nb 10)))
    (if (zero? nb)
        0
        (if p?
            (+ (alternate-digit-sum quot #f) reste)
            (- (alternate-digit-sum quot #t) reste)))))
 
(display "Un nombre est-il divisible par 11 ?" )
(newline)
(display "Essai avec 286 et 288")
 
(define (divisible-by-11? i)
  (let ((res (alternate-digit-sum i #f)))
    (if (< res 10)
        (if (zero? res) #t #f)
        (divisible-by-11? res))))
(divisible-by-11? 286)
(divisible-by-11? 288)

Débuts en Scheme

Fr@nZ — Sat, 21 Nov 2009 11:54:00 +0100

Voici un petit programme présentant quelques fonctions de base en Scheme. Définition et utilisation d'une variable :

(define pi (* 4 (atan 1)))
(+ (* 4.1 9.8) (/ (* 2 pi) 3))

Si vous voulez donner des paramètres à une fonction (symbole fonctionnelle d'arité > 0 (constante)), vous pouvez le faire comme ci-dessous avec i, u et f paramètres de power.

(+ (exp pi) (log (sin 2.1)) (sin (+ (/ 1 pi) pi)))
(define (power u i f) (* u i (cos (* 2 pi f))))
(define (power-50 u i) (* u i (cos (* 2 pi 50))))
(define (fq->power f) (lambda (u i) (power u i f)))
;pas une fonction, synonyme
(define power-50-v2 (fq->power 50))
(power-50-v2 220 7)

Lecture et Ecriture dans un fichier en Prolog

Fr@nZ — Sat, 21 Nov 2009 11:45:00 +0100

Voici un exemple d'I/O en Prolog :

% Exemple 8 : utilisation de read/1 et write/1
addition:- write('Entrez un nombre :'),read(A),write('Entrez un autre nombre:'),read(B), Z is A+B, nl, write(A), write('+'),write(B),write('='), write(Z).
 
% Exemple 9 : utilisation de read/2 , write/2, close et open
addition:- open('Fichier.txt',append,Stream),write(Stream,'3'),
write(Stream, '+'), write(Stream, '4'),
write(Stream, '='), write(Stream,'7 '), close(Stream).

Les listes en Prolog

Fr@nZ — Sat, 21 Nov 2009 11:41:00 +0100

Voici un petit fichier commenté sur la gestion des listes en Prolog :

% Exemple 3 : Listes
appartient(X,[X|Y]).
appartient(X,[Z|Y]):- appartient(X,Y).

% Exemple11 : utilisation du 'not' : \+
complement(X,L,M):- appartient(X,L), \+appartient(X,M).
 
% 1 : rend le premier élément d'une liste
premier(X,[X|Y]).
 
% Dernier element d'une liste
dernier(X,[X]).
dernier(X,[Y|L]):- dernier(X,L).
 
% ajoute un element au début d'une liste
ajout_debut(X,L,[X|L]). 
 
% ajoute un element a la fin d'une liste
ajout_fin(X,[],[X]).
ajout_fin(X,[Y|L1],[Y|L2]):- ajout_fin(X,L1,L2).
 
% vérifie que les éléments de L1 sont bien dans L2
inclus([],L2).
inclus([X|L1],L2):- appartient(X,L2) , inclus(L1,L2).
 
% renverse une liste de poids deux ou trois
renverse_liste([],L2,L3).
renverse_liste(X,Z):- renverse_liste(X,[],Z).
renverse_liste([X|L1],L2,L3):- ajout_debut(X,L2,L3) , renverse_liste(L1,[],L3).
 
% Exemple 4 : Listes (suite) : concatene == "R est la concaténée de L1,L2"
concatene([],L2,L2).
concatene([X|L1],L2,[X|R]):- concatene(L1,L2,R).
 
% Exemple 5 : utilisation de min, max et is
add_min_max:- X is min(4,5)+max(5,1).

Ecrire des règles

Fr@nZ — Sat, 21 Nov 2009 11:25:00 +0100

Voici quelques règles toutes simples, pour comprendre l'idée du Prolog.

convient_physiquement(X,Y):- homme(Y,T,C,A) , recherche(X,T,C,A).
convient_physiquement(X,Y):- femme(Y,T,C,A) , recherche(X,T,C,A).
 
ont_memes_gouts(X,Y):- gout(X,M,L,S) , gout(Y,M,L,S).