Association Tunisienne pour l'Informatique Scolaire Index du Forum

Association Tunisienne pour l'Informatique Scolaire
BACCALAUREAT INFORMATIQUE et CAPES INFORMATIQUE

 FAQFAQ   RechercherRechercher   MembresMembres   GroupesGroupes   S’enregistrerS’enregistrer 
 ProfilProfil   Se connecter pour vérifier ses messages privésSe connecter pour vérifier ses messages privés   ConnexionConnexion 

corbac4si_2012

 
Poster un nouveau sujet   Répondre au sujet    Association Tunisienne pour l'Informatique Scolaire Index du Forum -> Bac Sciences de l'Informatique -> BAC 2008 - 2009 - 2010 - 2011 - 2012 -> BAC PRATIQUE 2012
Sujet précédent :: Sujet suivant  
Auteur Message
hichem2010
6- Professeur

Hors ligne

Inscrit le: 12 Nov 2009
Messages: 24
Emploi: Professeur
Localisation: Sidi Bouzid
Lycée/collège: lycée bir elhaffey
Sexe: Masculin
Point(s): 13

MessagePosté le: Jeu 24 Mai 2012 - 20:13    Sujet du message: corbac4si_2012 Répondre en citant

une soltion de sujet algo et prog de 8h30 et 10h30
vos commentaires


Revenir en haut
Publicité






MessagePosté le: Jeu 24 Mai 2012 - 20:13    Sujet du message: Publicité

PublicitéSupprimer les publicités ?
Revenir en haut
hichem2010
6- Professeur

Hors ligne

Inscrit le: 12 Nov 2009
Messages: 24
Emploi: Professeur
Localisation: Sidi Bouzid
Lycée/collège: lycée bir elhaffey
Sexe: Masculin
Point(s): 13

MessagePosté le: Jeu 24 Mai 2012 - 20:16    Sujet du message: corbac4si_2012 Répondre en citant


program prat8h30_201;

uses wincrt;

type fiche=file of integer;  tab=array[1..20]of integer;

var f:fiche;fn:text;n,p:integer;

procedure saisir(var n,p:integer);

begin

repeat

write('n=');

readln(n);

until (n>2) and (n<100);

repeat

write('p=');

readln(p);

until (p>2) and (p<6);

end;

procedure remplir_f(var f:fiche; n,p:integer);

var i,nb:integer;ch:string;

begin

for i:=1 to n do

begin

repeat

write('nb=');

readln(nb);

str(nb,ch);

until length(ch)=p;

write(f,nb);

end;end;

procedure  fact_premier(nb:integer;var t:tab;var c:integer);

var j:integer;

begin

j:=2;  ; c:=0;

repeat

if nb mod j=0 then

begin

c:=c+1;

t[c]:=j;

nb:=nb div j;

end

else

begin

j:=j+1;

end;

 until nb=1;

end;

function relative(t:tab;c:integer):string;

var k,i,j,d:integer;ch1,chk,ch2:string;

begin

j:=1; ch1:='';d:=t[j]; i:=1;

while j<=c do

begin

k:=1;

while (t[i]=t[i+1]) and (i<c) do

begin

k:=k+1;i:=i+1; j:=j+1;

end;

i:=i+1;  j:=j+1;

str(k,chk);  str(d,ch2);

d:=t[j];

ch1:=ch1+chk+ch2;

end;

relative:=ch1;

end;

procedure remplir_fn(var f:fiche;var fn:text; n:integer);

var i,nb,c:integer;  ch1:string; t:tab;

begin

reset(f);

for i:=1 to n do

begin

read(f,nb);

fact_premier(nb,t,c);

ch1:=relative(t,c);

writeln(fn,ch1);

end;

end;

procedure afficher_fn(var fn:text);

var ligne:string;

begin

reset(fn) ;

while not (eof(fn)) do

begin

readln(fn,ligne);

writeln(ligne);

end;

end;

begin

assign(f,'e:\bac2012\dev8h30\nombre.dat');

rewrite(f);

assign(fn,'e:\bac2012\dev8h30\facteur.txt');

rewrite(fn);

saisir(n,p);

remplir_f(f,n,p);

remplir_fn(f,fn,n);

clrscr;

afficher_fn(fn);

close(f);

close(fn);

end.

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

program dev10H30;

uses wincrt;

type fiche=file of integer;

var f:fiche;p,q:integer;

procedure saisir(var p,q:integer);

begin

repeat

write('p=');readln(p);

write('q=');readln(q);

until (10<p) and(p<q) and (q<20000);

end;

function premier(x:integer):boolean;

var j:integer;

begin

j:=2;

while (x mod j<>0) and  (j<= x div 2) do

j:=j+1;

if(j> x div 2)then

premier:=true

else

premier:=false;

end;

function rotation(x:integer):integer;

var ch,ch1:string;i,a,e:integer;

begin

str(x,ch);

ch1:=ch[length(ch)];

for i:=1 to length(ch)-1 do

ch1:=ch1+ch[i];

val(ch1,a,e);

rotation:=a;

end;

function premcirc(i:integer):boolean;

var n,m:integer;

begin

n:=rotation(i);

m:=rotation(n);

premcirc:=false;

if premier(i) and (premier(n)) and (premier(m)) then

premcirc:=true;

end;

procedure remplir(var f:fiche; p,q:integer);

var i:integer;

begin

for i:=p to q do

if premcirc(i) then

write(f,i);

end;

procedure afficher(var f:fiche);

var nb:integer;

begin

reset(f);

while not(eof(f)) do

begin

read(f,nb);

writeln(nb);

end;

end;

begin

assign(f,'e:\bac2012\dev10h30\circul.dat');

rewrite(f);

saisir(p,q);

remplir(f,p,q);

clrscr;

afficher(f);

close(f);

end.


Revenir en haut
bara


Hors ligne

Inscrit le: 13 Jan 2012
Messages: 1
Emploi: Professeur
Localisation: Mannouba
Lycée/collège: lycée hannibal tébourba
Point(s): 0

MessagePosté le: Jeu 24 Mai 2012 - 20:37    Sujet du message: corbac4si_2012 Répondre en citant

bien , une solution très clair et juste /exécutable

Revenir en haut
bibani
6- Professeur

Hors ligne

Inscrit le: 16 Mai 2009
Messages: 32
Emploi: Professeur
Localisation: Mednine
Lycée/collège: midoun
Sexe: Masculin
Point(s): 5

MessagePosté le: Jeu 24 Mai 2012 - 21:17    Sujet du message: corbac4si_2012 Répondre en citant

2<p<6, donc fichier de longint

Revenir en haut
hichem2010
6- Professeur

Hors ligne

Inscrit le: 12 Nov 2009
Messages: 24
Emploi: Professeur
Localisation: Sidi Bouzid
Lycée/collège: lycée bir elhaffey
Sexe: Masculin
Point(s): 13

MessagePosté le: Sam 26 Mai 2012 - 12:17    Sujet du message: corbac4si_2012 Répondre en citant

merci
mais une rectification pour la solution de 10h30
car la solution donneé teste seulement un nombre de 3chiffre

 program dev10H30;
uses wincrt;
type fiche=file of integer;
var f:fiche;p,q:integer;
procedure saisir(var p,q:integer);
begin
repeat
write('p=');readln(p);
write('q=');readln(q);
until (10<p) and(p<q) and (q<20000);
end;
function premier(x:integer):boolean;
var j:integer;
begin
j:=2;
while (x mod j<>0) and  (j<= x div 2) do
j:=j+1;
if(j> x div 2)then
premier:=true
else
premier:=false;
end;
function rotation(x:integer):integer;
var ch,ch1:string;i,a,e:integer;
begin
str(x,ch);
ch1:=ch[length(ch)]+copy(ch,1,length(ch)-1);
val(ch1,a,e);
rotation:=a;
end;
function premcirc(i:integer):boolean;
var j:integer;   ch:string; v:boolean;
begin
v:=premier(i);str(i,ch);j:=1;
while v and(j<length(ch)) do
begin
j:=j+1;
i:=rotation(i);
v:=premier(i);
end;
premcirc:=v;
end;
procedure remplir(var f:fiche; p,q:integer);
var i:integer;
begin
for i:=p to q do
if premcirc(i) then
write(f,i);
end;
procedure afficher(var f:fiche);
var nb:integer;
begin
reset(f);
while not(eof(f)) do
begin
read(f,nb);
writeln(nb);
end;
end;
begin
assign(f,'e:\bac2012\dev10h30\circul.dat');
rewrite(f);
saisir(p,q);
remplir(f,p,q);
clrscr;
afficher(f);
close(f);
end.


Revenir en haut
hichem2010
6- Professeur

Hors ligne

Inscrit le: 12 Nov 2009
Messages: 24
Emploi: Professeur
Localisation: Sidi Bouzid
Lycée/collège: lycée bir elhaffey
Sexe: Masculin
Point(s): 13

MessagePosté le: Sam 26 Mai 2012 - 12:18    Sujet du message: corbac4si_2012 Répondre en citant

oui le fichier doit etre de type longint

Revenir en haut
hichem2010
6- Professeur

Hors ligne

Inscrit le: 12 Nov 2009
Messages: 24
Emploi: Professeur
Localisation: Sidi Bouzid
Lycée/collège: lycée bir elhaffey
Sexe: Masculin
Point(s): 13

MessagePosté le: Lun 28 Mai 2012 - 18:59    Sujet du message: corbac4si_2012 Répondre en citant

solution de 14h30
suite robinson

program robinson;
uses wincrt;
var k:integer;  var f:text;
procedure saisir(var k:integer);
begin
repeat
write('k=');
readln(k);
until (k>=2) and (k<=15);
end;
function min(ch:string):string;
var e,i,x,mi:integer;   ch_m:string;
begin
mi:=9;
for i:=1 to length(ch) do
begin
val(ch[i],x,e);
if x<mi then
mi:=x;
end;
str(mi,ch_m);
min:=ch_m;
end;
function robin(v:string):string;
var i,s,p:integer; u,ch_s,c:string;
begin
s:=0;
u:='';
repeat
c:=min(v);
repeat                          
p:=pos(c,v);
if p<>0 then
begin
s:=s+1;
delete(v,p,1);
end;
until (p=0);
str(s,ch_s);
u:=ch_s+c+u;
s:=0;
until length(v)=0;
robin:=u;
end;
procedure remplir_f(var f:text;k:integer);
var v,u:string; i:integer;
begin
v:='0'; writeln(f,'U0=',v);
for i:= 1 to k do
begin
u:=robin(v);
v:=u;
writeln(f,'U',i,'=',u);
end;
end;
procedure affichage ( var f:text);
var ch:string;
begin
reset(f);
while (not(eof(f)))do
begin
readln(f,ch);
writeln(ch);
end;
end;
begin
assign(f,'e:\bac2012\dev14h30\robinson.txt');
rewrite(f);
saisir(k);
remplir_f(f,k);
clrscr;
affichage(f);
close(f);
end.


Revenir en haut
Contenu Sponsorisé






MessagePosté le: Aujourd’hui à 09:00    Sujet du message: corbac4si_2012

Revenir en haut
Montrer les messages depuis:   
Poster un nouveau sujet   Répondre au sujet    Association Tunisienne pour l'Informatique Scolaire Index du Forum -> Bac Sciences de l'Informatique -> BAC 2008 - 2009 - 2010 - 2011 - 2012 -> BAC PRATIQUE 2012 Toutes les heures sont au format GMT + 1 Heure
Page 1 sur 1

 
Sauter vers:  

Index | Creer un forum | Forum gratuit d’entraide | Annuaire des forums gratuits | Signaler une violation | Conditions générales d'utilisation
Powered by phpBB © 2001, 2005 phpBB Group
Traduction par : phpBB-fr.com