hg S’enregistrer Bac Tunisie Algorithmique et programmation : BAC INFORMATIQUE En Tunisie forum informatique Tunisie

Bac Tunisie Algorithmique et programmation : BAC INFORMATIQUE En Tunisie  forum informatique Tunisie Index du Forum

hg Bac Tunisie Algorithmique et programmation TIC réseaux php javascript sql access activités programmation c
hg
FAQ FAQ Rechercher Rechercher Membres Membres Groupes Groupes Profil Profil Se connecter pour vérifier ses messages privés Messages Privés Connexion Connexion


 Forum de l'excellence et l'excellence en innovation 
Pour participer à notre Forum, vous devez
 
inscrire sur notre forum a partir d'ici
 
  NB :
Les membres ''zéro messages'' seront supprimés automatiquement après un nombre de jours donné !!!!
             
   
 
  
forum d'aide informatique : internet, réseau, programmation informatique ...
Correction Bac pratique Fichiers
 
 
Poster un nouveau sujet   Répondre au sujet    Bac Tunisie Algorithmique et programmation : BAC INFORMATIQUE En Tunisie forum informatique Tunisie Index du Forum -> Algorithmique & programmation -> (¯`·._.·[Devoirs et séries']·._.·´¯)
hg Sujet précédent :: Sujet suivant   hd
Auteur Message
KARIMOS
Administrateur

Hors ligne

Inscrit le: 02 Nov 2008
Messages: 1 710
Masculin
Point(s): 5 479
Moyenne de points: 0

Posté le: Sam 29 Nov - 09:33 (2008)    Sujet du message: Correction Bac pratique Fichiers Répondre en citant

PublicitéSupprimer les publicités ?


 
Revenir en haut
KARIMOS
Administrateur

Hors ligne

Inscrit le: 02 Nov 2008
Messages: 1 710
Masculin
Point(s): 5 479
Moyenne de points: 0

Posté le: Sam 29 Nov - 09:34 (2008)    Sujet du message: Correction Bac pratique Fichiers Répondre en citant

voici une solution mais il y a un erreur au niveau de suppression des espaces car il supprime tous les espaces
PROGRAM Phrases_21_mai_2008_10h30;
USES WinCrt;
VAR
F1, F2 : Text ; {noms logiques des deux fichiers texte}
np : Word ; {nombre de phrases du fichier}
nm : Word ; {nombre de mots du fichier}
Moy : Real ; {moyenne des mots dans une phrase}
{------------------------------------------------------------------------------------------------
Procédure "Creation", qui crée les deux fichiers F1 et F2
Attention : Le dossier bac2008 doit être présent sur le disque dur C: sinon le message d'erreur
"Run time 001 – 002e… Sera affiché à l'écran}
PROCEDURE Creation (VAR F1, F2 : Text);
BEGIN
Assign (F1, 'C:\bac2008\phrases.txt');
ReWrite (F1);
Assign (F2, 'C:\bac2008\phr_cor.txt');
ReWrite (F2);
END ;
{----------------------------------------------------------------------------------------------------------
Procédure "Remplir", qui sauvegarde dans le fichier F1, les phrases saisies au clavier}
PROCEDURE Remplir (VAR F1 : Text);
VAR
ligne : String;
BEGIN
Repeat
WriteLn('Taper une phrase ');
ReadLn (ligne);
If ligne <>'' Then WriteLn(F1, ligne);
Until (ligne = '') ;
END;
{----------------------------------------------------------------------------------------------------------
Procédure "Correction", qui supprime les espaces en plus et ajoute éventuellement un point à la fin de
la phrase puis enregistre la version corrigée dans le fichier F2}
PROCEDURE Correction (VAR F1, F2 : Text);
VAR
ligne : String;
p : Integer ;
BEGIN
Reset (F1);
While NOT (EOF (F1)) Do
Begin
{Lecture d'une phrase du fichier F1}
ReadLn(F1,ligne);
{Effacement des espaces en début de la phrase}
While ligne[1] =' ' Do
Begin
Delete (ligne, 1, 1);
End;
{Effacement des espaces en plus de la phrase}


{Effacement des éventuels espaces à la fin de la phrase}
While ligne [length(ligne )] = ' ' Do
Begin
Delete (ligne , length(ligne), 1);
End;
{Ajout d'un point en fin de phrase s'il n'existe pas}
If ligne [length(ligne)] <> '.' Then ligne := ligne + '.' ;
{Sauvegarde de la phrase corrigée dans le fichier F2}
WriteLn(F2, ligne) ;
End;
END;
{----------------------------------------------------------------------------------------------------------
Procédure "Calcul", qui calcul le nombre de phrases (np), le nombre de mots (nm) et la moyenne
(moy) des nombres de mot par phrase}
PROCEDURE Calcul (VAR F2 : Text; VAR np, nm : Word; VAR moy : Real);
VAR
ligne : String;
p : Integer ; {position d'un espace dans une phrase}
nml : Integer; {nombre de mot par ligne}
BEGIN
Reset (F2);
np := 0;
nm := 0;
While NOT (EOF (F2) ) Do
Begin
ReadLn (F2, ligne);
{Calcul du nombre de phrases}
np := np + 1;
{Calcul du nombre de mots par phrase}
nml := 1 ;
Repeat
p := Pos (' ',ligne);
if p <> 0 Then
Begin
nml := nml + 1;
Delete (ligne, 1, p);
End;
Until (p = 0);
{Calcul du nombre total de mots dans le fichier}
nm := nm + nml;
End;
{Calcul du nombre total de mots dans le fichier}
moy := nm / np;
END;
{----------------------------------------------------------------------------------------------------------
Programme principal }
BEGIN
Creation (F1, F2);
Remplir (F1);
Correction (F1, F2);
Calcul (F2, np, nm, moy);
WriteLn (' Nombre de phrases : ', np ,' Nombre de mots : ', nm , ' Moyenne : ', moy :5:2);
Close (F1);
Close (F2);
END.


 
Revenir en haut
KARIMOS
Administrateur

Hors ligne

Inscrit le: 02 Nov 2008
Messages: 1 710
Masculin
Point(s): 5 479
Moyenne de points: 0

Posté le: Sam 29 Nov - 09:35 (2008)    Sujet du message: Correction Bac pratique Fichiers Répondre en citant

Voilà une procédure qui permet de supprimer les espaces doubles


procedure suppr_espace (var ch : string);
var
p : integer;

begin
p:=pos('  ',ch); {chercher la position de deux espaces successives}
while (p<>0) do
 begin
  delete(ch,p,1);
  p:=pos('  ',ch);
 end;
end;


 
Revenir en haut
KARIMOS
Administrateur

Hors ligne

Inscrit le: 02 Nov 2008
Messages: 1 710
Masculin
Point(s): 5 479
Moyenne de points: 0

Posté le: Sam 29 Nov - 09:35 (2008)    Sujet du message: Correction Bac pratique Fichiers Répondre en citant

le programme devient
program tpp;
uses wincrt;
var
f1,f2:text;
nm,np:integer;
moy:real;
procedure creation(var f1:text);
var
rep:char;
ligne:string;
begin
assign(f1,'c:\phrase1.txt');
rewrite(f1);
repeat
writeln('donner une ligne');
readln(ligne);
writeln(f1,ligne);
repeat
writeln('vous voulez continuer');
readln(rep);
until upcase(rep)in['O','N'];
until upcase(rep)='N';
close(f1);
end;
procedure correction(var f1,f2:text);
var
p:integer;
ligne:string;
begin
assign(f1,'c:\phrase1.txt');
reset(f1);
assign(f2,'c:\phrase11.txt');
rewrite(f2);
while not (eof(f1))do
begin
readln(f1,ligne);
while(ligne[1]=' ')do
delete(ligne,1,1);
while(ligne[length(ligne)]=' ')do
delete(ligne,length(ligne),1);
if ligne[length(ligne)]<>'.'then
ligne:=ligne+'.';
p:=pos(' ',ligne); {chercher la position de deux espaces successives}
while (p<>0) do
begin
delete(ligne,p,1);
p:=pos(' ',ligne);
end;

writeln(f2,ligne);
end;
close(f2);
close(f1);
end;
procedure calculer(var f2:text;var nm,np:integer;var moy:real);
var
nml,p:integer;
ligne:string;
begin
assign(f2,'c:\phrase11.txt');
reset(f2);
nm:=0;
np:=0;
while not (eof(f2)) do
begin
readln(f2,ligne);
np:=np+1;
nml:=1;
repeat
p:=pos(' ',ligne);
if p<>0 then
begin
nml:=nml+1;
delete(ligne,p,1);
end;
until p=0;
nm:=nm+nml;
end;
moy:=nm/np;
close(f2);
end;
begin
creation(f1);
correction(f1,f2);
calculer(f2,nm,np,moy);
writeln('le nombre de mots',nm);
writeln('le nombre des phrases est',np);
writeln('la moyenne est:',moy);

end.


 
Revenir en haut
KARIMOS
Administrateur

Hors ligne

Inscrit le: 02 Nov 2008
Messages: 1 710
Masculin
Point(s): 5 479
Moyenne de points: 0

Posté le: Sam 9 Avr - 22:53 (2011)    Sujet du message: Correction Bac pratique Fichiers Répondre en citant

Arrow Arrow Arrow Arrow Arrow Arrow Arrow

 
Revenir en haut
Contenu Sponsorisé






Posté le: Aujourd’hui à 19:01 (2016)    Sujet du message: Correction Bac pratique Fichiers

 
Revenir en haut
Montrer les messages depuis:   
bg bd
Poster un nouveau sujet   Répondre au sujet    Bac Tunisie Algorithmique et programmation : BAC INFORMATIQUE En Tunisie forum informatique Tunisie Index du Forum -> Algorithmique & programmation -> (¯`·._.·[Devoirs et séries']·._.·´¯) Toutes les heures sont au format GMT + 1 Heure
 
Page 1 sur 1

 
Sauter vers:  
Index | créer forum gratuit | Forum gratuit d’entraide | Annuaire des forums gratuits | Signaler une violation | Conditions générales d'utilisation